[123747] branches/gsoc14-cleanup
ksammons at macports.org
ksammons at macports.org
Wed Aug 13 15:14:51 PDT 2014
Revision: 123747
https://trac.macports.org/changeset/123747
Author: ksammons at macports.org
Date: 2014-08-13 15:14:51 -0700 (Wed, 13 Aug 2014)
Log Message:
-----------
Final (hopefully) changes
Added Paths:
-----------
branches/gsoc14-cleanup/.DS_Store
branches/gsoc14-cleanup/base/
branches/gsoc14-cleanup/base/.DS_Store
branches/gsoc14-cleanup/base/doc/
branches/gsoc14-cleanup/base/doc/.DS_Store
branches/gsoc14-cleanup/base/doc/exampleport/
branches/gsoc14-cleanup/base/doc/exampleport/.DS_Store
branches/gsoc14-cleanup/src/.DS_Store
branches/gsoc14-cleanup/src/macports1.0/.DS_Store
branches/gsoc14-cleanup/src/macports1.0/tests/.DS_Store
branches/gsoc14-cleanup/src/port/port.BACKUP.23878
branches/gsoc14-cleanup/src/port/port.BASE.23878
branches/gsoc14-cleanup/src/port/port.LOCAL.23878
branches/gsoc14-cleanup/src/port/port.REMOTE.23878
branches/gsoc14-cleanup/src/port/port.orig
branches/gsoc14-cleanup/src/port/port.tcl.orig
Added: branches/gsoc14-cleanup/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,8 @@
+ Bud1 # c a l . m 4 @ \x80 @ \x80 @ \x80 @ #
+ a c l o c a l . m 4Ilocblob F (\xFF\xFF\xFF\xFF\xFF\xFF b a s eIlocblob \xCC ( \xFF\xFF b a s ebwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC b a s evSrnlong C h a n g e L o gIlocblob R (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i gIlocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g . g u e s sIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF
+ c o n f i g . l o gIlocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF
+ c o n f i g . s t a t u sIlocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ c o n f i g . s u bIlocblob \xCC \x98\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g u r eIlocblob R \x98\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g u r e . a cIlocblob \xD8 \x98\xFF\xFF\xFF\xFF\xFF\xFF d o cIlocblob ^ \x98\xFF\xFF\xFF\xFF\xFF\xFF D o x y f i l eIlocblob \xE4 \x98\xFF\xFF\xFF\xFF\xFF\xFF D o x y f i l e . i nIlocblob F \xFF\xFF\xFF\xFF\xFF\xFF H A C K I N GIlocblob \xCC \xFF\xFF\xFF\xFF\xFF\xFF
+ i n s t a l l . s hIlocblob R \xFF\xFF\xFF\xFF\xFF\xFF L I C E N S EIlocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF m 4Ilocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s - p u b k e y . p e mIlocblob \xE4 \xFF\xFF\xFF\xFF\xFF\xFF M a k e f i l eIlocblob F x\xFF\xFF\xFF\xFF\xFF\xFF M a k e f i l e . i nIlocblob \xCC x\xFF\xFF\xFF\xFF\xFF\xFF M kIlocblob R x\xFF\xFF\xFF\xFF\xFF\xFF N E W SIlocblob \xD8 x\xFF\xFF\xFF\xFF\xFF\xFF p o r t m g rIlocblob ^ x\xFF\xFF\xFF\xFF\xFF\xFF R E A D M E . m dIlocblob \xE4 x\xFF\xFF\xFF\xFF\xFF\xFF r e g e n . s hIlocblob F \xE8\xFF\xFF\xFF\xFF\xFF\xFF
+ s e t u p e n v . b a s hIlocblob \xCC \xE8\xFF\xFF\xFF\xFF\xFF\xFF s e t u p e n v . b a s h . i nIlocblob R \xE8\xFF\xFF\xFF\xFF\xFF\xFF s r cIlocblob \xD8 \xE8 \xFF\xFF s r cbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC s r cvSrnlong s t a n d a r d _ c o n f i g u r e . s hIlocblob ^ \xE8\xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob \xE4 \xE8\xFF\xFF\xFF\xFF\xFF\xFF v e n d o rIlocblob F X\xFF\xFF\xFF\xFF\xFF\xFF E DSDB ` \x80 ( 0 @ \x80 @ \x80 @ M kIlocblob R x\xFF\xFF\xFF\xFF\xFF\xFF N E W SIlocblob \xD8 x\xFF\xFF\xFF\xFF\xFF\xFF p o r t m g rIlocblob ^ x\xFF\xFF\xFF\xFF\xFF\xFF R E A D M E . m dIlocblob \xE4 x\xFF\xFF\xFF\xFF\xFF\xFF r e g e n . s hIlocblob F \xE8\xFF\xFF\xFF\xFF\xFF\xFF
+ s e t u p e n v . b a s hIlocblob \xCC \xE8\xFF\xFF\xFF\xFF\xFF\xFF s e t u p e n v . b a s h . i nIlocblob R \xE8\xFF\xFF\xFF\xFF\xFF\xFF s r cIlocblob \xD8 \xE8 \xFF\xFF s r cbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC s r cvSrnlong s t a n d a r d _ c o n f i g u r e . s hIlocblob ^ \xE8\xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob \xE4 \xE8\xFF\xFF\xFF\xFF\xFF\xFF v e
\ No newline at end of file
Added: branches/gsoc14-cleanup/base/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/base/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/base/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,4 @@
+ Bud1 c a l . m 4 @ \x80 @ \x80 @ \x80 @
+ a c l o c a l . m 4Ilocblob F (\xFF\xFF\xFF\xFF\xFF\xFF C h a n g e L o gIlocblob \xCC (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i gIlocblob R (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g . g u e s sIlocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF
+ c o n f i g . s u bIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g u r eIlocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g u r e . a cIlocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF d o cIlocblob \xCC \x98 \xFF\xFF d o cbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{335, 226}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC d o cvSrnlong D o x y f i l e . i nIlocblob R \x98\xFF\xFF\xFF\xFF\xFF\xFF H A C K I N GIlocblob \xD8 \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ i n s t a l l . s hIlocblob ^ \x98\xFF\xFF\xFF\xFF\xFF\xFF L I C E N S EIlocblob \xE4 \x98\xFF\xFF\xFF\xFF\xFF\xFF m 4Ilocblob F \xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s - p u b k e y . p e mIlocblob \xCC \xFF\xFF\xFF\xFF\xFF\xFF M a k e f i l e . i nIlocblob R \xFF\xFF\xFF\xFF\xFF\xFF M kIlocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF N E W SIlocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF p o r t m g rIlocblob \xE4 \xFF\xFF\xFF\xFF\xFF\xFF r e g e n . s hIlocblob F x\xFF\xFF\xFF\xFF\xFF\xFF s e t u p e n v . b a s h . i nIlocblob \xCC x\xFF\xFF\xFF\xFF\xFF\xFF s r cIlocblob R x\xFF\xFF\xFF\xFF\xFF\xFF s t a n d a r d _ c o n f i g u r e . s hIlocblob \xD8 x\xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob ^ x\xFF\xFF\xFF\xFF\xFF\xFF v e n d o rIlocblob \xE4 x\xFF\xFF\xFF\xFF\xFF\xFF E DSDB ` \x80 @ \x80 @ \x80 @ Ilocblob R x\xFF\xFF\xFF\xFF\xFF\xFF s t a n d a r d _ c o n f i g u r e . s hIlocblob \xD8 x\xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob ^ x\xFF\xFF\xFF\xFF\xFF\xFF v e n d o rIlocblob \xE4 x\xFF\xFF\xFF\xFF\xFF\xFF
\ No newline at end of file
Added: branches/gsoc14-cleanup/base/doc/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/base/doc/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/base/doc/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5 @@
+ Bud1 i v e _ s i @ \x80 @ \x80 @ \x80 @ a r c h i v e _ s i t e s . c o n fIlocblob F (\xFF\xFF\xFF\xFF\xFF\xFF
+ b a s e . m t r e e . i nIlocblob \xCC (\xFF\xFF\xFF\xFF\xFF\xFF e x a m p l e p o r tIlocblob R ( \xFF\xFF e x a m p l e p o r tbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{335, 226}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC e x a m p l e p o r tvSrnlong I N T E R N A L SIlocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF m a c o s x . m t r e e . i nIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s . c o n f . 5Ilocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s . c o n f . i nIlocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF M a k e f i l e . i nIlocblob \xCC \x98\xFF\xFF\xFF\xFF\xFF\xFF p o r t . 1Ilocblob R \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ p o r t f i l e . 7Ilocblob \xD8 \x98\xFF\xFF\xFF\xFF\xFF\xFF p o r t g r o u p . 7Ilocblob ^ \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ p o r t h i e r . 7Ilocblob \xE4 \x98\xFF\xFF\xFF\xFF\xFF\xFF p o r t s t y l e . 7Ilocblob F \xFF\xFF\xFF\xFF\xFF\xFF p r e f i x . m t r e e . i nIlocblob \xCC \xFF\xFF\xFF\xFF\xFF\xFF p u b k e y s . c o n f . i nIlocblob R \xFF\xFF\xFF\xFF\xFF\xFF s o u r c e s . c o n fIlocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF
+ v a r i a n t s . c o n fIlocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF E DSDB ` \x80 @ \x80 @ \x80 @
\ No newline at end of file
Added: branches/gsoc14-cleanup/base/doc/exampleport/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/base/doc/exampleport/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/base/doc/exampleport/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1 @@
+ Bud1 \x86 f i l eIloc P o r t f i l eIlocblob F (\xFF\xFF\xFF\xFF\xFF\xFF @ \x80 @ \x80 @ \x80 @ E \x86 DSDB ` \xC0 @ \x80 @ \x80 @
\ No newline at end of file
Added: branches/gsoc14-cleanup/src/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/src/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/src/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,4 @@
+ Bud1 b 1 . 0Iloc @ \x80 @ \x80 @ \x80 @ c f l i b 1 . 0Ilocblob F (\xFF\xFF\xFF\xFF\xFF\xFF c o n f i g . h . i nIlocblob \xCC (\xFF\xFF\xFF\xFF\xFF\xFF c r e g i s t r yIlocblob R (\xFF\xFF\xFF\xFF\xFF\xFF d a r w i n t r a c e l i b 1 . 0Ilocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF d e d u p _ p o r t f i l e s . t c l . i nIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF i m a g e s _ t o _ a r c h i v e s . t c l . i nIlocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF m a c h i s t a 1 . 0Ilocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s 1 . 0Ilocblob \xCC \x98 \xFF\xFF m a c p o r t s 1 . 0bwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC m a c p o r t s 1 . 0vSrnlong M a k e f i l e . i nIlocblob R \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ p a c k a g e 1 . 0Ilocblob \xD8 \x98\xFF\xFF\xFF\xFF\xFF\xFF
+ p e x t l i b 1 . 0Ilocblob ^ \x98\xFF\xFF\xFF\xFF\xFF\xFF p k g _ m k i n d e x . s h . i nIlocblob \xE4 \x98\xFF\xFF\xFF\xFF\xFF\xFF p o r tIlocblob F \xFF\xFF\xFF\xFF\xFF\xFF p o r t 1 . 0Ilocblob \xCC \xFF\xFF\xFF\xFF\xFF\xFF p r o g r a m sIlocblob R \xFF\xFF\xFF\xFF\xFF\xFF r e g i s t r y 2 . 0Ilocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF
+ t c l o b j c 1 . 0Ilocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF # u p g r a d e _ s o u r c e s _ c o n f _ d e f a u l t . t c l . i nIlocblob \xE4 \xFF\xFF\xFF\xFF\xFF\xFF E DSDB ` \x80 @ \x80 @ \x80 @ s o u r c e s _ c o n f _ d e f a u l t . t c l . i nIlocblob \xE4 \xFF\xFF\xFF\xFF\xFF\xFF
\ No newline at end of file
Added: branches/gsoc14-cleanup/src/macports1.0/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/src/macports1.0/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/src/macports1.0/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,3 @@
+ Bud1 o r . t c l @ \x80 @ \x80 @ \x80 @
+ d o c t o r . t c lIlocblob F x\xFF\xFF\xFF\xFF\xFF\xFF d o c t o r . t c l . o r i gIlocblob F (\xFF\xFF\xFF\xFF\xFF\xFF ! g e t _ s y s t e m c o n f i g u r a t i o n _ p r o x i e s . cIlocblob \xCC (\xFF\xFF\xFF\xFF\xFF\xFF ! g e t _ s y s t e m c o n f i g u r a t i o n _ p r o x i e s . hIlocblob R (\xFF\xFF\xFF\xFF\xFF\xFF
+ m a c p o r t s . cIlocblob \xCC \x98\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s . t c lIlocblob R \x98\xFF\xFF\xFF\xFF\xFF\xFF
m a c p o r t s . t c l . B A C K U P . 2 1 7 2 2 . t c lIlocblob \xD8 \x98\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s . t c l . B A S E . 2 1 7 2 2 . t c lIlocblob ^ \x98\xFF\xFF\xFF\xFF\xFF\xFF
m a c p o r t s . t c l . L O C A L . 2 1 7 2 2 . t c lIlocblob \xE4 \x98\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s . t c l . o r i gIlocblob F \xFF\xFF\xFF\xFF\xFF\xFF
m a c p o r t s . t c l . R E M O T E . 2 1 7 2 2 . t c lIlocblob \xCC \xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s _ a u t o c o n f . t c l . i nIlocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s _ d l i s t . t c lIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF
m a c p o r t s _ t e s t _ a u t o c o n f . t c l . i nIlocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s _ u t i l . t c lIlocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF M a k e f i l e . i nIlocblob R \xFF\xFF\xFF\xFF\xFF\xFF r e c l a i m . t c lIlocblob \xCC x\xFF\xFF\xFF\xFF\xFF\xFF s y s c t l . cIlocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF s y s c t l . hIlocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob \xE4 \xFF\xFF t e s t sbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC t e s t svSrnlong E DSDB ` \x80 @ \x80 @ \x80 @ l . cIlocblob \xD8 \xFF\xFF\xFF\xFF\xFF\xFF s y s c t l . hIlocblob ^ \xFF\xFF\xFF\xFF\xFF\xFF t e s t sIlocblob \xE4 \xFF\xFF t e s t sbwspblob \xDDbplist00\xD8 ]ShowStatusBar[ShowPathbar[ShowToolbar[ShowTabView_ContainerShowSidebar\WindowBounds\SidebarWidth[ShowSidebar _{{355, 206}, {1010, 566}}\x97 '3?Kbo|\x88\x89\x8A\x8B\x8C\x8D\xA9\xAB \xAC t e s t svSrnlong
\ No newline at end of file
Added: branches/gsoc14-cleanup/src/macports1.0/tests/.DS_Store
===================================================================
--- branches/gsoc14-cleanup/src/macports1.0/tests/.DS_Store (rev 0)
+++ branches/gsoc14-cleanup/src/macports1.0/tests/.DS_Store 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,2 @@
+ Bud1 a r y . t c l i b r a r y . t c lIlocblob F (\xFF\xFF\xFF\xFF\xFF\xFF
+ m a c p o r t s . t e s tIlocblob \xD8 (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s _ d l i s t . t e s tIlocblob \xCC (\xFF\xFF\xFF\xFF\xFF\xFF m a c p o r t s _ u t i l . t e s tIlocblob R (\xFF\xFF\xFF\xFF\xFF\xFF P o r t f i l eIlocblob ^ (\xFF\xFF\xFF\xFF\xFF\xFF s o u r c e s . c o n fIlocblob \xE4 (\xFF\xFF\xFF\xFF\xFF\xFF t e s t . t c lIlocblob F \x98\xFF\xFF\xFF\xFF\xFF\xFF @ \x80 @ \x80 @ \x80 @ E DSDB ` \x80 @ \x80 @ \x80 @
\ No newline at end of file
Added: branches/gsoc14-cleanup/src/port/port.BACKUP.23878
===================================================================
--- branches/gsoc14-cleanup/src/port/port.BACKUP.23878 (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.BACKUP.23878 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5362 @@
+#!/opt/local/libexec/macports/bin/tclsh8.5
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_doctor { action portlist opts } {
+<<<<<<< HEAD
+ macports::doctor_main
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+ macports::doctor_main $opts
+>>>>>>> svn
+ return 0
+}
+
+proc action_reclaim { action portlist opts } {
+<<<<<<< HEAD
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+>>>>>>> svn
+ macports::reclaim_main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ doctor [list action_doctor [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+ doctor {quiet}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
Added: branches/gsoc14-cleanup/src/port/port.BASE.23878
===================================================================
--- branches/gsoc14-cleanup/src/port/port.BASE.23878 (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.BASE.23878 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5343 @@
+#!/opt/local/libexec/macports/bin/tclsh8.5
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require reclaim 1.0
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_reclaim { action portlist opts } {
+ reclaim::main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs gsoc14}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
Added: branches/gsoc14-cleanup/src/port/port.LOCAL.23878
===================================================================
--- branches/gsoc14-cleanup/src/port/port.LOCAL.23878 (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.LOCAL.23878 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5348 @@
+#!/opt/local/libexec/macports/bin/tclsh8.5
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_doctor { action portlist opts } {
+ macports::doctor_main
+ return 0
+}
+
+proc action_reclaim { action portlist opts } {
+ macports::reclaim_main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ doctor [list action_doctor [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
Added: branches/gsoc14-cleanup/src/port/port.REMOTE.23878
===================================================================
--- branches/gsoc14-cleanup/src/port/port.REMOTE.23878 (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.REMOTE.23878 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5355 @@
+#!/opt/local/libexec/macports/bin/tclsh8.5
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_doctor { action portlist opts } {
+ if {[prefix_unwritable]} {
+ return 1
+ }
+ macports::doctor_main $opts
+ return 0
+}
+
+proc action_reclaim { action portlist opts } {
+ if {[prefix_unwritable]} {
+ return 1
+ }
+ macports::reclaim_main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ doctor [list action_doctor [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+ doctor {quiet}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
Added: branches/gsoc14-cleanup/src/port/port.orig
===================================================================
--- branches/gsoc14-cleanup/src/port/port.orig (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.orig 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5362 @@
+#!/opt/local/libexec/macports/bin/tclsh8.5
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_doctor { action portlist opts } {
+<<<<<<< HEAD
+ macports::doctor_main
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+ macports::doctor_main $opts
+>>>>>>> svn
+ return 0
+}
+
+proc action_reclaim { action portlist opts } {
+<<<<<<< HEAD
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+>>>>>>> svn
+ macports::reclaim_main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ doctor [list action_doctor [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+ doctor {quiet}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
Added: branches/gsoc14-cleanup/src/port/port.tcl.orig
===================================================================
--- branches/gsoc14-cleanup/src/port/port.tcl.orig (rev 0)
+++ branches/gsoc14-cleanup/src/port/port.tcl.orig 2014-08-13 22:14:51 UTC (rev 123747)
@@ -0,0 +1,5361 @@
+# -*- 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
+# $Id: port.tcl 119177 2014-04-18 22:35:29Z cal at macports.org $
+#
+# Copyright (c) 2004-2014 The MacPorts Project
+# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
+# Copyright (c) 2002-2003 Apple Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+# Create a namespace for some local variables
+namespace eval portclient::progress {
+ ##
+ # Indicate whether the term::ansi::send tcllib package is available and was
+ # imported. "yes", if the package is available, "no" otherwise.
+ variable hasTermAnsiSend no
+}
+
+if {![catch {package require term::ansi::send}]} {
+ set portclient::progress::hasTermAnsiSend yes
+}
+
+package require macports
+package require Pextlib 1.0
+
+# Standard procedures
+proc print_usage {{verbose 1}} {
+ global cmdname
+ set syntax {
+ [-bcdfknopqRstuvy] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
+ [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
+ }
+
+ if {$verbose} {
+ puts stderr "Usage: $cmdname$syntax"
+ puts stderr "\"$cmdname help\" or \"man 1 port\" for more information."
+ } else {
+ puts stderr "$cmdname$syntax"
+ }
+}
+
+proc print_help {args} {
+ global action_array
+
+ print_usage 0
+
+ # Generate and format the command list from the action_array
+ set cmds ""
+ set lineLen 0
+ foreach cmd [lsort [array names action_array]] {
+ if {$lineLen > 65} {
+ set cmds "$cmds,\n"
+ set lineLen 0
+ }
+ if {$lineLen == 0} {
+ set new "$cmd"
+ } else {
+ set new ", $cmd"
+ }
+ incr lineLen [string length $new]
+ set cmds "$cmds$new"
+ }
+
+ set cmdText "Supported actions
+------------------
+$cmds
+"
+
+ set text {
+Pseudo-portnames
+----------------
+Pseudo-portnames are words that may be used in place of a portname, and
+which expand to some set of ports. The common pseudo-portnames are:
+all, current, active, inactive, actinact, installed, uninstalled, outdated,
+obsolete, requested, unrequested and leaves.
+These pseudo-portnames expand to the set of ports named.
+
+Pseudo-portnames starting with variants:, variant:, description:, depends:,
+depends_lib:, depends_run:, depends_build:, depends_fetch:, depends_extract:,
+portdir:, homepage:, epoch:, platforms:, platform:, name:, long_description:,
+maintainers:, maintainer:, categories:, category:, version:, revision:, and
+license: each select a set of ports based on a regex search of metadata
+about the ports. In all such cases, a standard regex pattern following
+the colon will be used to select the set of ports to which the
+pseudo-portname expands.
+
+Pseudo-portnames starting with depof:, rdepof:, dependentof:, and rdependentof:
+select ports that are direct or recursive dependencies or dependents of the
+following portname, respectively.
+
+Portnames that contain standard glob characters will be expanded to the
+set of ports matching the glob pattern.
+
+Port expressions
+----------------
+Portnames, port glob patterns, and pseudo-portnames may be logically
+combined using expressions consisting of and, or, not, !, (, and ).
+
+For more information
+--------------------
+See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
+porthier(7), portstyle(7). Also, see http://www.macports.org.
+ }
+
+ puts "$cmdText$text"
+}
+
+
+# Produce error message and exit
+proc fatal s {
+ global argv0
+ ui_error "$argv0: $s"
+ exit 1
+}
+
+##
+# Helper function to define constants
+#
+# Constants defined with const can simply be accessed in the same way as
+# calling a proc.
+#
+# Example:
+# const FOO 42
+# puts [FOO]
+#
+# @param name variable name
+# @param value constant variable value
+proc const {name args} {
+ proc $name {} [list return [expr $args]]
+}
+
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+proc filesize {fil {unit {}}} {
+ set siz {@}
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+# Produce an error message, and exit, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc fatal_softcontinue s {
+ if {[macports::global_option_isset ports_force]} {
+ ui_error $s
+ return -code continue
+ } else {
+ fatal $s
+ }
+}
+
+
+# Produce an error message, and break, unless
+# we're handling errors in a soft fashion, in which
+# case we continue
+proc break_softcontinue { msg status name_status } {
+ upvar $name_status status_var
+ ui_error $msg
+ if {[macports::ui_isset ports_processall]} {
+ set status_var 0
+ return -code continue
+ } else {
+ set status_var $status
+ return -code break
+ }
+}
+
+# show the URL for the ticket reporting instructions
+proc print_tickets_url {args} {
+ if {${macports::prefix} ne "/usr/local" && ${macports::prefix} ne "/usr"} {
+ ui_error "Follow http://guide.macports.org/#project.tickets to report a bug."
+ }
+}
+
+# Form a composite version as is sometimes used for registry functions
+# This function sorts the variants and presents them in a canonical representation
+proc composite_version {version variations {emptyVersionOkay 0}} {
+ # Form a composite version out of the version and variations
+
+ # Select the variations into positive and negative
+ set pos {}
+ set neg {}
+ foreach { key val } $variations {
+ if {$val eq "+"} {
+ lappend pos $key
+ } elseif {$val eq "-"} {
+ lappend neg $key
+ }
+ }
+
+ # If there is no version, we have nothing to do
+ set composite_version ""
+ if {$version ne "" || $emptyVersionOkay} {
+ set pos_str ""
+ set neg_str ""
+
+ if {[llength $pos]} {
+ set pos_str "+[join [lsort -ascii $pos] "+"]"
+ }
+ if {[llength $neg]} {
+ set neg_str "-[join [lsort -ascii $neg] "-"]"
+ }
+
+ set composite_version "$version$pos_str$neg_str"
+ }
+
+ return $composite_version
+}
+
+
+proc split_variants {variants} {
+ set result {}
+ set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
+ foreach { match sign variant } $l {
+ lappend result $variant $sign
+ }
+ return $result
+}
+
+
+##
+# Maps friendly field names to their real name
+# Names which do not need mapping are not changed.
+#
+# @param field friendly name
+# @return real name
+proc map_friendly_field_names { field } {
+ switch -- $field {
+ variant -
+ platform -
+ maintainer -
+ subport {
+ set field "${field}s"
+ }
+ category {
+ set field "categories"
+ }
+ }
+
+ return $field
+}
+
+
+proc registry_installed {portname {portversion ""}} {
+ set ilist [registry::installed $portname $portversion]
+ if { [llength $ilist] > 1 } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ ui_notice "The following versions of $portname are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants} (active)"
+ }
+ }
+ return -code error "Registry error: Please specify the full version as recorded in the port registry."
+ } else {
+ return [lindex $ilist 0]
+ }
+}
+
+
+proc entry_for_portlist {portentry} {
+ global global_options global_variations
+
+ # Each portlist entry currently has the following elements in it:
+ # url if any
+ # name
+ # version (version_revision)
+ # variants array (variant=>+-)
+ # requested_variants array (variant=>+-)
+ # options array (key=>value)
+ # fullname (name/version_revision+-variants)
+
+ array set port $portentry
+ if {![info exists port(url)]} { set port(url) "" }
+ if {![info exists port(name)]} { set port(name) "" }
+ if {![info exists port(version)]} { set port(version) "" }
+ if {![info exists port(variants)]} { set port(variants) "" }
+ if {![info exists port(requested_variants)]} { set port(requested_variants) "" }
+ if {![info exists port(options)]} { set port(options) [array get global_options] }
+
+ # If neither portname nor url is specified, then default to the current port
+ if { $port(url) eq "" && $port(name) eq "" } {
+ set url file://.
+ set portname [url_to_portname $url]
+ set port(url) $url
+ set port(name) $portname
+ if {$portname eq ""} {
+ ui_error "A default port name could not be supplied."
+ }
+ }
+
+ # Form the fully discriminated portname: portname/version_revison+-variants
+ set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
+
+ return [array get port]
+}
+
+
+proc add_to_portlist {listname portentry} {
+ upvar $listname portlist
+
+ # Form portlist entry and add to portlist
+ lappend portlist [entry_for_portlist $portentry]
+}
+
+
+proc add_ports_to_portlist {listname ports {overridelist ""}} {
+ upvar $listname portlist
+
+ array set overrides $overridelist
+
+ # Add each entry to the named portlist, overriding any values
+ # specified as overrides
+ foreach portentry $ports {
+ array set port $portentry
+ if ([info exists overrides(version)]) { set port(version) $overrides(version) }
+ if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
+ if ([info exists overrides(requested_variants)]) { set port(requested_variants) $overrides(requested_variants) }
+ if ([info exists overrides(options)]) { set port(options) $overrides(options) }
+ add_to_portlist portlist [array get port]
+ }
+}
+
+
+proc url_to_portname { url {quiet 0} } {
+ # Save directory and restore the directory, since mportopen changes it
+ set savedir [pwd]
+ set portname ""
+ if {[catch {set ctx [mportopen $url]} result]} {
+ if {!$quiet} {
+ ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
+ ui_msg "Please verify that the directory and portfile syntax are correct."
+ }
+ } else {
+ array set portinfo [mportinfo $ctx]
+ set portname $portinfo(name)
+ mportclose $ctx
+ }
+ cd $savedir
+ return $portname
+}
+
+
+# Supply a default porturl/portname if the portlist is empty
+proc require_portlist { nameportlist {is_upgrade "no"} } {
+ global private_options
+ upvar $nameportlist portlist
+
+ if {[llength $portlist] == 0 && (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ if {${is_upgrade} == "yes"} {
+ # $> port upgrade outdated
+ # Error: No ports matched the given expression
+ # is not very user friendly - if we're in the special case of
+ # "upgrade", let's print a message that's a little easier to
+ # understand and less alarming.
+ ui_msg "Nothing to upgrade."
+ return 1
+ }
+ ui_error "No ports matched the given expression"
+ return 1
+ }
+
+ if {[llength $portlist] == 0} {
+ set portlist [get_current_port]
+
+ if {[llength $portlist] == 0} {
+ # there was no port in current directory
+ return 1
+ }
+ }
+
+ return 0
+}
+
+
+# Execute the enclosed block once for every element in the portlist
+# When the block is entered, the following variables will have been set:
+# portspec, porturl, portname, portversion, options, variations, requested_variations
+proc foreachport {portlist block} {
+ set savedir [pwd]
+ foreach portspec $portlist {
+
+ # Set the variables for the block
+ uplevel 1 "array unset portspec; array set portspec { $portspec }"
+ uplevel 1 {
+ set porturl $portspec(url)
+ set portname $portspec(name)
+ set portversion $portspec(version)
+ array unset variations
+ array set variations $portspec(variants)
+ array unset requested_variations
+ array set requested_variations $portspec(requested_variants)
+ array unset options
+ array set options $portspec(options)
+ }
+
+ # Invoke block
+ uplevel 1 $block
+
+ # Restore cwd after each port, since mportopen changes it, and otherwise relative
+ # urls would break on subsequent passes
+ if {[file exists $savedir]} {
+ cd $savedir
+ } else {
+ cd ~
+ }
+ }
+}
+
+
+proc portlist_compare { a b } {
+ array set a_ $a
+ array set b_ $b
+ set namecmp [string equal -nocase $a_(name) $b_(name)]
+ if {$namecmp != 1} {
+ if {$a_(name) eq [lindex [lsort -dictionary [list $a_(name) $b_(name)]] 0]} {
+ return -1
+ }
+ return 1
+ }
+ set avr_ [split $a_(version) "_"]
+ set bvr_ [split $b_(version) "_"]
+ set versioncmp [vercmp [lindex $avr_ 0] [lindex $bvr_ 0]]
+ if {$versioncmp != 0} {
+ return $versioncmp
+ }
+ set ar_ [lindex $avr_ 1]
+ set br_ [lindex $bvr_ 1]
+ if {$ar_ < $br_} {
+ return -1
+ } elseif {$ar_ > $br_} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+# Sort two ports in NVR (name at version_revision) order
+proc portlist_sort { list } {
+ return [lsort -command portlist_compare $list]
+}
+
+proc portlist_compareint { a b } {
+ array set a_ [list "name" [lindex $a 0] "version" "[lindex $a 1]_[lindex $a 2]"]
+ array set b_ [list "name" [lindex $b 0] "version" "[lindex $b 1]_[lindex $b 2]"]
+ return [portlist_compare [array get a_] [array get b_]]
+}
+
+# Same as portlist_sort, but with numeric indexes {name version revision}
+proc portlist_sortint { list } {
+ return [lsort -command portlist_compareint $list]
+}
+
+# sort portlist so dependents come before their dependencies
+proc portlist_sortdependents { portlist } {
+ foreach p $portlist {
+ array set pvals $p
+ lappend entries($pvals(name)) $p
+ if {![info exists dependents($pvals(name))]} {
+ set dependents($pvals(name)) {}
+ foreach result [registry::list_dependents $pvals(name)] {
+ lappend dependents($pvals(name)) [lindex $result 2]
+ }
+ }
+ array unset pvals
+ }
+ set ret {}
+ foreach p $portlist {
+ portlist_sortdependents_helper $p entries dependents seen ret
+ }
+ return $ret
+}
+
+proc portlist_sortdependents_helper {p up_entries up_dependents up_seen up_retlist} {
+ upvar $up_seen seen
+ if {![info exists seen($p)]} {
+ set seen($p) 1
+ upvar $up_entries entries $up_dependents dependents $up_retlist retlist
+ array set pvals $p
+ foreach dependent $dependents($pvals(name)) {
+ if {[info exists entries($dependent)]} {
+ foreach entry $entries($dependent) {
+ portlist_sortdependents_helper $entry entries dependents seen retlist
+ }
+ }
+ }
+ lappend retlist $p
+ }
+}
+
+proc regex_pat_sanitize { s } {
+ set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
+ return $sanitized
+}
+
+##
+# Makes sure we get the current terminal size
+proc term_init_size {} {
+ global env
+
+ if {![info exists env(COLUMNS)] || ![info exists env(LINES)]} {
+ if {[isatty stdout]} {
+ set size [term_get_size stdout]
+
+ if {![info exists env(LINES)] && [lindex $size 0] > 0} {
+ set env(LINES) [lindex $size 0]
+ }
+
+ if {![info exists env(COLUMNS)] && [lindex $size 1] > 0} {
+ set env(COLUMNS) [lindex $size 1]
+ }
+ }
+ }
+}
+
+##
+# Wraps a multi-line string at specified textwidth
+#
+# @see wrapline
+#
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrap {string maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set splitstring {}
+ set indentline $indentfirstline
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $indent $indentline]
+ set indentline 1
+ }
+ return [join $splitstring "\n"]
+}
+
+##
+# Wraps a line at specified textwidth
+#
+# @see wrap
+#
+# @param line input line
+# @param maxlen text width (0 defaults to current terminal width)
+# @param indent prepend to every line
+# @return wrapped string
+proc wrapline {line maxlen {indent ""} {indentfirstline 1}} {
+ global env
+
+ if {$maxlen == 0} {
+ if {![info exists env(COLUMNS)]} {
+ # no width for wrapping
+ return $string
+ }
+ set maxlen $env(COLUMNS)
+ }
+
+ set string [split $line " "]
+ if {$indentfirstline == 0} {
+ set newline ""
+ set maxlen [expr {$maxlen - [string length $indent]}]
+ } else {
+ set newline $indent
+ }
+ append newline [lindex $string 0]
+ set joiner " "
+ set first 1
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline $indent
+ set joiner ""
+ # If indentfirstline is set to 0, reset maxlen to its
+ # original length after appending the first line to lines.
+ if {$first == 1 && $indentfirstline == 0} {
+ set maxlen [expr {$maxlen + [string length $indent]}]
+ }
+ set first 0
+ }
+ append newline $joiner $word
+ set joiner " "
+ }
+ lappend lines $newline
+ return [join $lines "\n"]
+}
+
+##
+# Wraps a line at a specified width with a label in front
+#
+# @see wrap
+#
+# @param label label for output
+# @param string input string
+# @param maxlen text width (0 defaults to current terminal width)
+# @return wrapped string
+proc wraplabel {label string maxlen {indent ""}} {
+ append label ": [string repeat " " [expr {[string length $indent] - [string length "$label: "]}]]"
+ return "$label[wrap $string $maxlen $indent 0]"
+}
+
+proc unobscure_maintainers { list } {
+ set result {}
+ foreach m $list {
+ if {[string first "@" $m] < 0} {
+ if {[string first ":" $m] >= 0} {
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ } else {
+ set m "$m at macports.org"
+ }
+ }
+ lappend result $m
+ }
+ return $result
+}
+
+
+##########################################
+# Port selection
+##########################################
+proc unique_results_to_portlist {infos} {
+ set result {}
+ array unset unique
+ foreach {name info} $infos {
+ array unset portinfo
+ array set portinfo $info
+
+ set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
+
+ array unset entry
+ array set entry $portentry
+
+ if {[info exists unique($entry(fullname))]} continue
+ set unique($entry(fullname)) 1
+
+ lappend result $portentry
+ }
+ return $result
+}
+
+
+proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
+ if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+
+ # Return the list of all ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_all_ports {} {
+ global all_ports_cache
+
+ if {![info exists all_ports_cache]} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "listing all ports failed: $result"
+ }
+ set results [unique_results_to_portlist $res]
+ set all_ports_cache [portlist_sort $results]
+ }
+ return $all_ports_cache
+}
+
+
+proc get_current_ports {} {
+ # This is just a synonym for get_current_port that
+ # works with the regex in element
+ return [get_current_port]
+}
+
+
+proc get_current_port {} {
+ set url file://.
+ set portname [url_to_portname $url]
+ if {$portname eq ""} {
+ ui_msg "To use the current port, you must be in a port's directory."
+ return [list]
+ }
+
+ set results {}
+ add_to_portlist results [list url $url name $portname]
+ return $results
+}
+
+
+proc get_installed_ports { {ignore_active yes} {active yes} } {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [split_variants [lindex $i 3]]
+ set iactive [lindex $i 4]
+
+ if { ${ignore_active} == "yes" || (${active} == "yes") == (${iactive} != 0) } {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+
+proc get_uninstalled_ports {} {
+ # Return all - installed
+ set all [get_all_ports]
+ set installed [get_installed_ports]
+ return [opComplement $all $installed]
+}
+
+
+proc get_active_ports {} {
+ return [get_installed_ports no yes]
+}
+
+
+proc get_inactive_ports {} {
+ return [get_installed_ports no no]
+}
+
+proc get_actinact_ports {} {
+ set inactive_ports [get_inactive_ports]
+ set active_ports [get_active_ports]
+ set results {}
+
+ foreach port $inactive_ports {
+ array set portspec $port
+ set portname $portspec(name)
+ lappend inact($portname) $port
+ }
+
+ foreach port $active_ports {
+ array set portspec $port
+ set portname $portspec(name)
+
+ if {[info exists inact($portname)]} {
+ if {![info exists added_inact($portname)]} {
+ foreach inact_spec $inact($portname) {
+ lappend results $inact_spec
+ }
+ set added_inact($portname) 1
+ }
+ lappend results $port
+ }
+ }
+ return $results
+}
+
+
+proc get_outdated_ports {} {
+ # Get the list of installed ports
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ # Now process the list, keeping only those ports that are outdated
+ set results {}
+ if { [llength $ilist] > 0 } {
+ foreach i $ilist {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+ set installed_variants [lindex $i 3]
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} continue
+
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "lookup of portname $portname failed: $result"
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts stderr "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set comp_result 0
+ if {$installed_version != $latest_version} {
+ set comp_result [expr {$installed_epoch - $latest_epoch}]
+ if { $comp_result == 0 } {
+ set comp_result [vercmp $installed_version $latest_version]
+ }
+ }
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ if {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision $installed_variants $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ }
+ }
+
+ # Add outdated ports to our results list
+ if { $comp_result < 0 } {
+ add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_obsolete_ports {} {
+ set ilist [get_installed_ports]
+ set results {}
+
+ foreach i $ilist {
+ array set port $i
+
+ if {[catch {mportlookup $port(name)} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+
+ if {[llength $result] < 2} {
+ lappend results $i
+ }
+ }
+
+ # Return the list of ports, already sorted
+ return [portlist_sort $results]
+}
+
+# return ports that have registry property $propname set to $propval
+proc get_ports_with_prop {propname propval} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iepoch [lindex $i 5]
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
+ if {[registry::property_retrieve $regref $propname] == $propval} {
+ add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants [split_variants $ivariants]]
+ }
+ }
+
+ # Return the list of ports, sorted
+ return [portlist_sort $results]
+}
+
+proc get_requested_ports {} {
+ return [get_ports_with_prop requested 1]
+}
+
+proc get_unrequested_ports {} {
+ return [get_ports_with_prop requested 0]
+}
+
+proc get_leaves_ports {} {
+ set ilist {}
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "port installed failed: $result"
+ }
+ }
+ registry::open_dep_map
+ set results {}
+ foreach i $ilist {
+ set iname [lindex $i 0]
+ if {[registry::list_dependents $iname] eq ""} {
+ add_to_portlist results [list name $iname version "[lindex $i 1]_[lindex $i 2]" variants [split_variants [lindex $i 3]]]
+ }
+ }
+ return [portlist_sort [opIntersection $results [get_unrequested_ports]]]
+}
+
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+proc get_dep_ports {portname recursive} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its deps
+ set results {}
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+
+ set deplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach dep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $dep :] end]]
+ lappend deplist $dep
+ }
+ }
+ }
+
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $depname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ ui_error "Port $depname not found"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open its portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "Unable to open port: $result"
+ continue
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # collect its deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ add_to_portlist results [list name [lindex [split $rdep :] end]]
+ lappend rdeplist $rdep
+ }
+ }
+ }
+
+ # add them to the lists
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex [split $rdep :] end]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+proc get_subports {portname} {
+ global global_variations
+
+ # look up portname
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "lookup of portname $portname failed: $result"
+ }
+ if {[llength $result] < 2} {
+ return -code error "Port $portname not found"
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+
+ # open portfile
+ if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ return -code error "Unable to open port: $result"
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # gather its subports
+ set results {}
+
+ if {[info exists portinfo(subports)]} {
+ foreach subport $portinfo(subports) {
+ add_to_portlist results [list name $subport]
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
+##########################################
+# Port expressions
+##########################################
+proc portExpr { resname } {
+ upvar $resname reslist
+ set result [seqExpr reslist]
+ return $result
+}
+
+
+proc seqExpr { resname } {
+ upvar $resname reslist
+
+ # Evaluate a sequence of expressions a b c...
+ # These act the same as a or b or c
+
+ set result 1
+ while {$result} {
+ switch -- [lookahead] {
+ ; -
+ ) -
+ _EOF_ { break }
+ }
+
+ set blist {}
+ set result [orExpr blist]
+ if {$result} {
+ # Calculate the union of result and b
+ set reslist [opUnion $reslist $blist]
+ }
+ }
+
+ return $result
+}
+
+
+proc orExpr { resname } {
+ upvar $resname reslist
+
+ set a [andExpr reslist]
+ while ($a) {
+ switch -- [lookahead] {
+ or {
+ advance
+ set blist {}
+ if {![andExpr blist]} {
+ return 0
+ }
+
+ # Calculate a union b
+ set reslist [opUnion $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc andExpr { resname } {
+ upvar $resname reslist
+
+ set a [unaryExpr reslist]
+ while {$a} {
+ switch -- [lookahead] {
+ and {
+ advance
+
+ set blist {}
+ set b [unaryExpr blist]
+ if {!$b} {
+ return 0
+ }
+
+ # Calculate a intersect b
+ set reslist [opIntersection $reslist $blist]
+ }
+ default {
+ return $a
+ }
+ }
+ }
+
+ return $a
+}
+
+
+proc unaryExpr { resname } {
+ upvar $resname reslist
+ set result 0
+
+ switch -- [lookahead] {
+ ! -
+ not {
+ advance
+ set blist {}
+ set result [unaryExpr blist]
+ if {$result} {
+ set all [get_all_ports]
+ set reslist [opComplement $all $blist]
+ }
+ }
+ default {
+ set result [element reslist]
+ }
+ }
+
+ return $result
+}
+
+
+proc element { resname } {
+ upvar $resname reslist
+ set el 0
+
+ set url ""
+ set name ""
+ set version ""
+ array unset requested_variants
+ array unset options
+
+ set token [lookahead]
+ switch -regex -- $token {
+ ^\\)$ -
+ ^\; -
+ ^_EOF_$ { # End of expression/cmd/file
+ }
+
+ ^\\($ { # Parenthesized Expression
+ advance
+ set el [portExpr reslist]
+ if {!$el || ![match ")"]} {
+ set el 0
+ }
+ }
+
+ ^all(@.*)?$ -
+ ^installed(@.*)?$ -
+ ^uninstalled(@.*)?$ -
+ ^active(@.*)?$ -
+ ^inactive(@.*)?$ -
+ ^actinact(@.*)?$ -
+ ^leaves(@.*)?$ -
+ ^outdated(@.*)?$ -
+ ^obsolete(@.*)?$ -
+ ^requested(@.*)?$ -
+ ^unrequested(@.*)?$ -
+ ^current(@.*)?$ {
+ # A simple pseudo-port name
+ advance
+
+ # Break off the version component, if there is one
+ regexp {^(\w+)(@.*)?} $token matchvar name remainder
+
+ add_multiple_ports reslist [get_${name}_ports] $remainder
+
+ set el 1
+ }
+
+ ^variants: -
+ ^variant: -
+ ^description: -
+ ^portdir: -
+ ^homepage: -
+ ^epoch: -
+ ^platforms: -
+ ^platform: -
+ ^name: -
+ ^long_description: -
+ ^maintainers: -
+ ^maintainer: -
+ ^categories: -
+ ^category: -
+ ^version: -
+ ^depends_lib: -
+ ^depends_build: -
+ ^depends_run: -
+ ^depends_extract: -
+ ^depends_fetch: -
+ ^replaced_by: -
+ ^revision: -
+ ^subport: -
+ ^subports: -
+ ^license: { # Handle special port selectors
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ # Remap friendly names to actual names
+ set field [map_friendly_field_names $field]
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
+ set el 1
+ }
+
+ ^depends: { # A port selector shorthand for depends_{lib,build,run,fetch,extract}
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar field pat
+
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_lib"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_build"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_run"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_extract"]
+ add_multiple_ports reslist [get_matching_ports $pat no regexp "depends_fetch"]
+
+ set el 1
+ }
+
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdependentof"]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^depof: -
+ ^rdepof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector "rdepof"]
+ add_multiple_ports reslist [get_dep_ports $portname $recursive]
+
+ set el 1
+ }
+
+ ^subportof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ add_multiple_ports reslist [get_subports $portname]
+
+ set el 1
+ }
+
+ [][?*] { # Handle portname glob patterns
+ advance; add_multiple_ports reslist [get_matching_ports $token no glob]
+ set el 1
+ }
+
+ ^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
+ advance
+ set name [url_to_portname $token]
+ if {$name ne ""} {
+ parsePortSpec version requested_variants options
+ add_to_portlist reslist [list url $token \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ } else {
+ ui_error "Can't open URL '$token' as a port"
+ set el 0
+ }
+ }
+
+ default { # Treat anything else as a portspec (portname, version, variants, options
+ # or some combination thereof).
+ parseFullPortSpec url name version requested_variants options
+ add_to_portlist reslist [list url $url \
+ name $name \
+ version $version \
+ requested_variants [array get requested_variants] \
+ variants [array get requested_variants] \
+ options [array get options]]
+ set el 1
+ }
+ }
+
+ return $el
+}
+
+
+proc add_multiple_ports { resname ports {remainder ""} } {
+ upvar $resname reslist
+
+ set version ""
+ array unset variants
+ array unset options
+ parsePortSpec version variants options $remainder
+
+ array unset overrides
+ if {$version ne ""} { set overrides(version) $version }
+ if {[array size variants]} {
+ # we always record the requested variants separately,
+ # but requested ones always override existing ones
+ set overrides(requested_variants) [array get variants]
+ set overrides(variants) [array get variants]
+ }
+ if {[array size options]} { set overrides(options) [array get options] }
+
+ add_ports_to_portlist reslist $ports [array get overrides]
+}
+
+
+proc unique_entries { entries } {
+ # Form the list of all the unique elements in the list a,
+ # considering only the port fullname, and taking the first
+ # found element first
+ set result {}
+ array unset unique
+ foreach item $entries {
+ array set port $item
+ if {[info exists unique($port(fullname))]} continue
+ set unique($port(fullname)) 1
+ lappend result $item
+ }
+ return $result
+}
+
+
+proc opUnion { a b } {
+ # Return the unique elements in the combined two lists
+ return [unique_entries [concat $a $b]]
+}
+
+
+proc opIntersection { a b } {
+ set result {}
+
+ # Rules we follow in performing the intersection of two port lists:
+ #
+ # a/, a/ ==> a/
+ # a/, b/ ==>
+ # a/, a/1.0 ==> a/1.0
+ # a/1.0, a/ ==> a/1.0
+ # a/1.0, a/2.0 ==>
+ #
+ # If there's an exact match, we take it.
+ # If there's a match between simple and discriminated, we take the later.
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem [unique_entries $b] {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, matching against b
+ foreach aitem [unique_entries $a] {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+ foreach match $matches {
+ if {$simpleform} {
+ set i $bfull($match)
+ lappend result [lindex $b $i]
+ } else {
+ lappend result $aitem
+ }
+ }
+ }
+
+ return $result
+}
+
+
+proc opComplement { a b } {
+ set result {}
+
+ # Return all elements of a not matching elements in b
+
+ # First create a list of the fully discriminated names in b
+ array unset bfull
+ set i 0
+ foreach bitem $b {
+ array set port $bitem
+ set bfull($port(fullname)) $i
+ incr i
+ }
+
+ # Walk through each item in a, taking all those items that don't match b
+ foreach aitem $a {
+ array set port $aitem
+
+ # Quote the fullname and portname to avoid special characters messing up the regexp
+ set safefullname [regex_pat_sanitize $port(fullname)]
+
+ set simpleform [expr { "$port(name)/" == $port(fullname) }]
+ if {$simpleform} {
+ set pat "^${safefullname}"
+ } else {
+ set safename [regex_pat_sanitize $port(name)]
+ set pat "^${safefullname}$|^${safename}/$"
+ }
+
+ set matches [array names bfull -regexp $pat]
+
+ # We copy this element to result only if it didn't match against b
+ if {![llength $matches]} {
+ lappend result $aitem
+ }
+ }
+
+ return $result
+}
+
+
+proc parseFullPortSpec { urlname namename vername varname optname } {
+ upvar $urlname porturl
+ upvar $namename portname
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ set portname ""
+ set portversion ""
+ array unset portvariants
+ array unset portoptions
+
+ if { [moreargs] } {
+ # Look first for a potential portname
+ #
+ # We need to allow a wide variety of tokens here, because of actions like "provides"
+ # so we take a rather lenient view of what a "portname" is. We allow
+ # anything that doesn't look like either a version, a variant, or an option
+ set token [lookahead]
+
+ set remainder ""
+ if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
+ advance
+ regexp {^([^@]+)(@.*)?} $token match portname remainder
+
+ # If the portname contains a /, then try to use it as a URL
+ if {[string match "*/*" $portname]} {
+ set url "file://$portname"
+ set name [url_to_portname $url 1]
+ if { $name ne "" } {
+ # We mapped the url to valid port
+ set porturl $url
+ set portname $name
+ # Continue to parse rest of portspec....
+ } else {
+ # We didn't map the url to a port; treat it
+ # as a raw string for something like port contents
+ # or cd
+ set porturl ""
+ # Since this isn't a port, we don't try to parse
+ # any remaining portspec....
+ return
+ }
+ }
+ }
+
+ # Now parse the rest of the spec
+ parsePortSpec portversion portvariants portoptions $remainder
+ }
+}
+
+# check if the install prefix is writable
+# should be called by actions that will modify it
+proc prefix_unwritable {} {
+ global macports::portdbpath
+ if {[file writable $portdbpath]} {
+ return 0
+ } else {
+ ui_error "Insufficient privileges to write to MacPorts install prefix."
+ return 1
+ }
+}
+
+
+proc parsePortSpec { vername varname optname {remainder ""} } {
+ upvar $vername portversion
+ upvar $varname portvariants
+ upvar $optname portoptions
+
+ global global_options
+
+ set portversion ""
+ array unset portoptions
+ array set portoptions [array get global_options]
+ array unset portvariants
+
+ # Parse port version/variants/options
+ set opt $remainder
+ set adv 0
+ set consumed 0
+ for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
+
+ # Refresh opt as needed
+ if {$opt eq ""} {
+ if {$adv} advance
+ set opt [lookahead]
+ set adv 1
+ set consumed 0
+ }
+
+ # Version must be first, if it's there at all
+ if {$firstTime && [string match {@*} $opt]} {
+ # Parse the version
+
+ # Strip the @
+ set opt [string range $opt 1 end]
+
+ # Handle the version
+ set sepPos [string first "/" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "/" to disambiguate -variant from part of version
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt [expr {$sepPos + 1}] end]
+ } else {
+ # Version terminated by "+", or else is complete
+ set sepPos [string first "+" $opt]
+ if {$sepPos >= 0} {
+ # Version terminated by "+"
+ set portversion [string range $opt 0 [expr {$sepPos - 1}]]
+ set opt [string range $opt $sepPos end]
+ } else {
+ # Unterminated version
+ set portversion $opt
+ set opt ""
+ }
+ }
+ set consumed 1
+ } else {
+ # Parse all other options
+
+ # Look first for a variable setting: VARNAME=VALUE
+ if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
+ # It's a variable setting
+ set portoptions($key) "\"$val\""
+ set opt ""
+ set consumed 1
+ } elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
+ # It's a variant
+ set portvariants($variant) $sign
+ set opt [string range $opt [expr {[string length $variant] + 1}] end]
+ set consumed 1
+ } else {
+ # Not an option we recognize, so break from port option processing
+ if { $consumed && $adv } advance
+ break
+ }
+ }
+ }
+}
+
+
+##########################################
+# Action Handlers
+##########################################
+
+proc action_get_usage { action } {
+ global action_array cmd_opts_array
+
+ if {[info exists action_array($action)]} {
+ set cmds ""
+ if {[info exists cmd_opts_array($action)]} {
+ foreach opt $cmd_opts_array($action) {
+ if {[llength $opt] == 1} {
+ set name $opt
+ set optc 0
+ } else {
+ set name [lindex $opt 0]
+ set optc [lindex $opt 1]
+ }
+
+ append cmds " --$name"
+
+ for {set i 1} {$i <= $optc} {incr i} {
+ append cmds " <arg$i>"
+ }
+ }
+ }
+ set args ""
+ set needed [action_needs_portlist $action]
+ if {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <arguments>"
+ } elseif {[ACTION_ARGS_STRINGS] == $needed} {
+ set args " <portlist>"
+ }
+
+ set ret "Usage: "
+ set len [string length $action]
+ append ret [wrap "$action$cmds$args" 0 [string repeat " " [expr {8 + $len}]] 0]
+ append ret "\n"
+
+ return $ret
+ }
+
+ return -1
+}
+
+proc action_usage { action portlist opts } {
+ if {[llength $portlist] == 0} {
+ print_usage
+ return 0
+ }
+
+ foreach topic $portlist {
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+ }
+ return 0
+}
+
+
+proc action_help { action portlist opts } {
+ set helpfile "$macports::prefix/var/macports/port-help.tcl"
+
+ if {[llength $portlist] == 0} {
+ print_help
+ return 0
+ }
+
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
+ } else {
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
+
+ foreach topic $portlist {
+ if {![info exists porthelp($topic)]} {
+ puts stderr "No help for topic $topic"
+ return 1
+ }
+
+ set usage [action_get_usage $topic]
+ if {$usage != -1} {
+ puts -nonewline stderr $usage
+ } else {
+ ui_error "No usage for topic $topic"
+ return 1
+ }
+
+ puts stderr $porthelp($topic)
+ }
+
+ return 0
+}
+
+
+proc action_log { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ set portname $portinfo(name)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ array unset portinfo
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ set portname $portinfo(name)
+ }
+ set portpath [macports::getportdir $porturl]
+ set logfile [file join [macports::getportlogpath $portpath $portname] "main.log"]
+ if {[file exists $logfile]} {
+ if {[catch {set fp [open $logfile r]} result]} {
+ break_softcontinue "Could not open file $logfile: $result" 1 status
+ }
+ set data [read $fp]
+ set data [split $data "\n"]
+
+ if {[info exists global_options(ports_log_phase)]} {
+ set phase $global_options(ports_log_phase);
+ } else {
+ set phase "\[a-z\]*"
+ }
+
+ if {[info exists global_options(ports_log_level)]} {
+ set index [lsearch -exact ${macports::ui_priorities} $global_options(ports_log_level)]
+ if {$index == -1} {
+ set prefix ""
+ } else {
+ set prefix [join [lrange ${macports::ui_priorities} 0 $index] "|"]
+ }
+ } else {
+ set prefix "\[a-z\]*"
+ }
+ foreach line $data {
+ set exp "^:($prefix|any):($phase|any) (.*)$"
+ if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
+ puts "[macports::ui_prefix_default $lpriority]$lmsg"
+ }
+ }
+
+ close $fp
+ } else {
+ break_softcontinue "Log file for port $portname not found" 1 status
+ }
+ }
+ return 0
+}
+
+
+proc action_info { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set separator ""
+ foreachport $portlist {
+ set index_only 0
+ if {[info exists options(ports_info_index)] && $options(ports_info_index)} {
+ set index_only 1
+ }
+ puts -nonewline $separator
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq "" || $index_only} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!$index_only} {
+ # Add any global_variations to the variations
+ # specified for the port (so we get e.g. dependencies right)
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ unset options(subport)
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "no PortIndex entry found for $portname"
+ continue
+ }
+ array unset options ports_info_index
+
+ # Understand which info items are actually lists
+ # (this could be overloaded to provide a generic formatting code to
+ # allow us to, say, split off the prefix on libs)
+ array set list_map "
+ categories 1
+ depends_fetch 1
+ depends_extract 1
+ depends_build 1
+ depends_lib 1
+ depends_run 1
+ maintainers 1
+ platforms 1
+ variants 1
+ conflicts 1
+ subports 1
+ "
+
+ # Label map for pretty printing
+ array set pretty_label {
+ heading ""
+ variants Variants
+ depends_fetch "Fetch Dependencies"
+ depends_extract "Extract Dependencies"
+ depends_build "Build Dependencies"
+ depends_run "Runtime Dependencies"
+ depends_lib "Library Dependencies"
+ description "Brief Description"
+ long_description "Description"
+ fullname "Full Name: "
+ homepage Homepage
+ platforms Platforms
+ maintainers Maintainers
+ license License
+ conflicts "Conflicts with"
+ replaced_by "Replaced by"
+ subports "Sub-ports"
+ }
+
+ # Wrap-length map for pretty printing
+ array set pretty_wrap {
+ heading 0
+ replaced_by 22
+ variants 22
+ depends_fetch 22
+ depends_extract 22
+ depends_build 22
+ depends_run 22
+ depends_lib 22
+ description 22
+ long_description 22
+ homepage 22
+ platforms 22
+ license 22
+ conflicts 22
+ maintainers 22
+ subports 22
+ }
+
+ # Interpret a convenient field abbreviation
+ if {[info exists options(ports_info_depends)] && $options(ports_info_depends) eq "yes"} {
+ array unset options ports_info_depends
+ set options(ports_info_depends_fetch) yes
+ set options(ports_info_depends_extract) yes
+ set options(ports_info_depends_build) yes
+ set options(ports_info_depends_lib) yes
+ set options(ports_info_depends_run) yes
+ }
+
+ # Set up our field separators
+ set show_label 1
+ set field_sep "\n"
+ set subfield_sep ", "
+ set pretty_print 0
+
+ # For human-readable summary, which is the default with no options
+ if {[llength [array get options ports_info_*]] == 0} {
+ set pretty_print 1
+ } elseif {[info exists options(ports_info_pretty)]} {
+ set pretty_print 1
+ array unset options ports_info_pretty
+ }
+
+ # Tune for sort(1)
+ if {[info exists options(ports_info_line)]} {
+ array unset options ports_info_line
+ set noseparator 1
+ set show_label 0
+ set field_sep "\t"
+ set subfield_sep ","
+ }
+
+ # Figure out whether to show field name
+ set quiet [macports::ui_isset ports_quiet]
+ if {$quiet} {
+ set show_label 0
+ }
+ # In pretty-print mode we also suppress messages, even though we show
+ # most of the labels:
+ if {$pretty_print} {
+ set quiet 1
+ }
+
+ # Spin through action options, emitting information for any found
+ set fields {}
+ set opts_todo [array names options ports_info_*]
+ set fields_tried {}
+ if {![llength $opts_todo]} {
+ set opts_todo {ports_info_heading
+ ports_info_replaced_by
+ ports_info_subports
+ ports_info_variants
+ ports_info_skip_line
+ ports_info_long_description ports_info_homepage
+ ports_info_skip_line ports_info_depends_fetch
+ ports_info_depends_extract ports_info_depends_build
+ ports_info_depends_lib ports_info_depends_run
+ ports_info_conflicts
+ ports_info_platforms ports_info_license
+ ports_info_maintainers
+ }
+ }
+ foreach { option } $opts_todo {
+ set opt [string range $option 11 end]
+ # Artificial field name for formatting
+ if {$pretty_print && $opt eq "skip_line"} {
+ lappend fields ""
+ continue
+ }
+ # Artificial field names to reproduce prettyprinted summary
+ if {$opt eq "heading"} {
+ set inf "$portinfo(name) @$portinfo(version)"
+ set ropt "heading"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ append inf "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ append inf " ([join $portinfo(categories) ", "])"
+ }
+ } elseif {$opt eq "fullname"} {
+ set inf "$portinfo(name) @"
+ append inf [composite_version $portinfo(version) $portinfo(active_variants)]
+ set ropt "fullname"
+ } else {
+ # Map from friendly name
+ set ropt [map_friendly_field_names $opt]
+
+ # If there's no such info, move on
+ if {![info exists portinfo($ropt)]} {
+ set inf ""
+ } else {
+ set inf [join $portinfo($ropt)]
+ }
+ }
+
+ # Calculate field label
+ set label ""
+ if {$pretty_print} {
+ if {[info exists pretty_label($ropt)]} {
+ set label $pretty_label($ropt)
+ } else {
+ set label $opt
+ }
+ } elseif {$show_label} {
+ set label "$opt: "
+ }
+
+ # Format the data
+ if { $ropt eq "maintainers" } {
+ set inf [unobscure_maintainers $inf]
+ }
+ # ... special formatting for certain fields when prettyprinting
+ if {$pretty_print} {
+ if {$ropt eq "variants"} {
+ # Use the new format for variants iff it exists in
+ # PortInfo. This key currently does not exist outside of
+ # trunk (1.8.0).
+ array unset vinfo
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ }
+
+ set pi_vars $inf
+ set inf {}
+ foreach v [lsort $pi_vars] {
+ set varmodifier ""
+ if {[info exists variations($v)]} {
+ # selected by command line, prefixed with +/-
+ set varmodifier $variations($v)
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ # Retrieve additional information from the new key.
+ } elseif {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+ if {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)]"
+ }
+ }
+ lappend inf "$varmodifier$v"
+ }
+ } elseif {[string match "depend*" $ropt]
+ && ![macports::ui_isset ports_verbose]} {
+ set pi_deps $inf
+ set inf {}
+ foreach d $pi_deps {
+ lappend inf [lindex [split $d :] end]
+ }
+ }
+ }
+ #End of special pretty-print formatting for certain fields
+ if {[info exists list_map($ropt)]} {
+ set field [join $inf $subfield_sep]
+ } else {
+ set field $inf
+ }
+
+ # Assemble the entry
+ if {$pretty_print} {
+ # The two special fields are considered headings and are
+ # emitted immediately, rather than waiting. Also they are not
+ # recorded on the list of fields tried
+ if {$ropt eq "heading" || $ropt eq "fullname"} {
+ puts "$label$field"
+ continue
+ }
+ }
+ lappend fields_tried $label
+ if {$pretty_print} {
+ if {$field eq ""} {
+ continue
+ }
+ if {$label eq ""} {
+ set wrap_len 0
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wrap $field 0 [string repeat " " $wrap_len]]
+ } else {
+ set wrap_len [string length $label]
+ if {[info exists pretty_wrap($ropt)]} {
+ set wrap_len $pretty_wrap($ropt)
+ }
+ lappend fields [wraplabel $label $field 0 [string repeat " " $wrap_len]]
+ }
+
+ } else { # Not pretty print
+ lappend fields "$label$field"
+ }
+ }
+
+ # Now output all that information:
+ if {[llength $fields]} {
+ puts [join $fields $field_sep]
+ } else {
+ if {$pretty_print && [llength $fields_tried]} {
+ puts -nonewline "$portinfo(name) has no "
+ puts [join $fields_tried ", "]
+ }
+ }
+ if {![info exists noseparator]} {
+ set separator "--\n"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_location { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port location failed: $result" 1 status
+ } else {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0]
+ set version [lindex $ilist 1]
+ set revision [lindex $ilist 2]
+ set variants [lindex $ilist 3]
+ set epoch [lindex $ilist 5]
+ }
+
+ set ref [registry::open_entry $portname $version $revision $variants $epoch]
+ set imagedir [registry::property_retrieve $ref location]
+ ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
+ puts $imagedir
+ }
+
+ return $status
+}
+
+
+proc action_notes { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+
+ set status 0
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # Look up the port.
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug $::errorInfo
+ break_softcontinue "The lookup of '$portname' failed: $result" \
+ 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "The port '$portname' was not found" 1 status
+ }
+
+ # Retrieve the port's URL.
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+
+ # Open the Portfile associated with this port.
+ if {[catch {set mport [mportopen $porturl [array get options] \
+ [array get merged_variations]]} \
+ result]} {
+ ui_debug $::errorInfo
+ break_softcontinue [concat "The URL '$porturl' could not be" \
+ "opened: $result"] 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+
+ # Return the notes associated with this Portfile.
+ if {[info exists portinfo(notes)]} {
+ set portnotes $portinfo(notes)
+ } else {
+ set portnotes {}
+ }
+
+ # Retrieve the port's name once more to ensure it has the proper case.
+ set portname $portinfo(name)
+
+ # Display the notes.
+ if {$portnotes ne {}} {
+ ui_notice "$portname has the following notes:"
+ foreach note $portnotes {
+ puts [wrap $note 0 " " 1]
+ }
+ } else {
+ puts "$portname has no notes."
+ }
+ }
+ return $status
+}
+
+
+proc action_provides { action portlist opts } {
+ # In this case, portname is going to be used for the filename... since
+ # that is the first argument we expect... perhaps there is a better way
+ # to do this?
+ if { ![llength $portlist] } {
+ ui_error "Please specify a filename to check which port provides that file."
+ return 1
+ }
+ foreach filename $portlist {
+ set file [file normalize $filename]
+ if {[file exists $file] || ![catch {file type $file}]} {
+ if {![file isdirectory $file] || [file type $file] eq "link"} {
+ set port [registry::file_registered $file]
+ if { $port != 0 } {
+ puts "$file is provided by: $port"
+ } else {
+ puts "$file is not provided by a MacPorts port."
+ }
+ } else {
+ puts "$file is a directory."
+ }
+ } else {
+ puts "$file does not exist."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+
+proc action_activate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_activate_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref activate [array get options]]} {
+ continue
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::activate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port activate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping activate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_deactivate { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ set portlist [portlist_sortdependents $portlist]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_deactivate_no-exec)]
+ && ![catch {set ilist [registry::active $portname]}]} {
+
+ set i [lindex $ilist 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ if {$composite_version eq "" || $composite_version == "${iversion}_${irevision}${ivariants}"} {
+ set regref [registry::entry open $portname $iversion $irevision $ivariants [lindex $i 5]]
+ if {[$regref installtype] eq "image" && [registry::run_target $regref deactivate [array get options]]} {
+ continue
+ }
+ }
+ }
+ if {![macports::global_option_isset ports_dryrun]} {
+ if { [catch {portimage::deactivate_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port deactivate failed: $result" 1 status
+ }
+ } else {
+ ui_msg "Skipping deactivate $portname (dry run)"
+ }
+ }
+
+ return $status
+}
+
+
+proc action_select { action portlist opts } {
+ ui_debug "action_select \[$portlist] \[$opts]..."
+
+ array set opts_array $opts
+ set commands [array names opts_array ports_select_*]
+ array unset opts_array
+
+ # Error out if no group is specified or command is not --summary.
+ if {[llength $portlist] < 1 && [string map {ports_select_ ""} [lindex $commands 0]] != "summary"} {
+ ui_error "port select \[--list|--set|--show|--summary] \<group> \[<version>]"
+ return 1
+ }
+
+ set group [lindex $portlist 0]
+
+ # If no command (--set, --show, --list, --summary) is specified *but*
+ # more than one argument is specified, default to the set command.
+ if {[llength $commands] < 1 && [llength $portlist] > 1} {
+ set command set
+ ui_debug [concat "Although no command was specified, more than " \
+ "one argument was specified. Defaulting to the " \
+ "'set' command..."]
+ # If no command (--set, --show, --list) is specified *and* less than two
+ # argument are specified, default to the list command.
+ } elseif {[llength $commands] < 1} {
+ set command list
+ ui_debug [concat "No command was specified. Defaulting to the " \
+ "'list' command..."]
+ # Only allow one command to be specified at a time.
+ } elseif {[llength $commands] > 1} {
+ ui_error [concat "Multiple commands were specified. Only one " \
+ "command may be specified at a time."]
+ return 1
+ } else {
+ set command [string map {ports_select_ ""} [lindex $commands 0]]
+ ui_debug "The '$command' command was specified."
+ }
+
+ switch -- $command {
+ list {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'list' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect show $group} selected_version]} {
+ global errorInfo
+ ui_debug $errorInfo
+ ui_warn "Unable to get active selected version: $selected_version"
+ }
+
+ # On error mportselect returns with the code 'error'.
+ if {[catch {mportselect $command $group} versions]} {
+ ui_error "The 'list' command failed: $versions"
+ return 1
+ }
+
+ ui_notice "Available versions for $group:"
+ foreach v $versions {
+ ui_notice -nonewline "\t"
+ if {$selected_version == $v} {
+ ui_msg "$v (active)"
+ } else {
+ ui_msg "$v"
+ }
+ }
+ return 0
+ }
+ set {
+ if {[llength $portlist] < 2} {
+ ui_error [concat "The 'set' command expects two " \
+ "arguments: <group>, <version>"]
+ return 1
+ } elseif {[llength $portlist] > 2} {
+ ui_warn [concat "The 'set' command only expects two " \
+ "arguments. Extra arguments will be " \
+ "ignored."]
+ }
+ set version [lindex $portlist 1]
+
+ ui_msg -nonewline "Selecting '$version' for '$group' "
+ if {[catch {mportselect $command $group $version} result]} {
+ ui_msg "failed: $result"
+ return 1
+ }
+ ui_msg "succeeded. '$version' is now active."
+ return 0
+ }
+ show {
+ if {[llength $portlist] > 1} {
+ ui_warn [concat "The 'show' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command $group} selected_version]} {
+ ui_error "The 'show' command failed: $selected_version"
+ return 1
+ }
+ puts [concat "The currently selected version for '$group' is " \
+ "'$selected_version'."]
+ return 0
+ }
+ summary {
+ if {[llength $portlist] > 0} {
+ ui_warn [concat "The 'summary' command does not expect any " \
+ "arguments. Extra arguments will be ignored."]
+ }
+
+ if {[catch {mportselect $command} portgroups]} {
+ ui_error "The 'summary' command failed: $portgroups"
+ return 1
+ }
+
+ set w1 4
+ set w2 8
+ set formatStr "%-*s %-*s %s"
+
+ set groups [list]
+ foreach pg $portgroups {
+ array set groupdesc {}
+ set groupdesc(name) [string trim $pg]
+
+ if {[catch {mportselect list $pg} versions]} {
+ ui_warn "The list of options for the select group $pg could not be obtained: $versions"
+ continue
+ }
+ # remove "none", sort the list, append none at the end
+ set noneidx [lsearch -exact $versions "none"]
+ set versions [lsort [lreplace $versions $noneidx $noneidx]]
+ lappend versions "none"
+ set groupdesc(versions) $versions
+
+ if {[catch {mportselect show $pg} selected_version]} {
+ ui_warn "The currently selected option for the select group $pg could not be obtained: $selected_version"
+ continue
+ }
+ set groupdesc(selected) $selected_version
+
+ set w1 [expr {max($w1, [string length $pg])}]
+ set w2 [expr {max($w2, [string length $selected_version])}]
+
+ lappend groups [array get groupdesc]
+ array unset groupdesc
+ }
+ puts [format $formatStr $w1 "Name" $w2 "Selected" "Options"]
+ puts [format $formatStr $w1 "====" $w2 "========" "======="]
+ foreach groupdesc $groups {
+ array set groupd $groupdesc
+ puts [format $formatStr $w1 $groupd(name) $w2 $groupd(selected) [join $groupd(versions) " "]]
+ array unset groupd
+ }
+ return 0
+ }
+ default {
+ ui_error "An unknown command '$command' was specified."
+ return 1
+ }
+ }
+}
+
+
+proc action_selfupdate { action portlist opts } {
+ global global_options
+ if { [catch {macports::selfupdate [array get global_options] base_updated} result ] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "$result"
+ if {![macports::ui_isset ports_verbose]} {
+ ui_msg "Please run `port -v selfupdate' for details."
+ } else {
+ # Let's only print the ticket URL if the user has followed the
+ # advice we printed earlier.
+ print_tickets_url
+ }
+ fatal "port selfupdate failed: $result"
+ }
+
+ if {$base_updated} {
+ # exit immediately if in batch/interactive mode
+ return -999
+ } else {
+ return 0
+ }
+}
+
+
+proc action_setrequested { action portlist opts } {
+ set status 0
+ if {[require_portlist portlist] || [prefix_unwritable]} {
+ return 1
+ }
+ # set or unset?
+ set val [string equal $action "setrequested"]
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![catch {set ilist [registry::installed $portname $composite_version]} result]} {
+ ui_info "Setting requested flag for $portname to $val"
+ foreach i $ilist {
+ set regref [registry::open_entry $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ registry::property_store $regref requested $val
+ }
+ } else {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_upgrade { action portlist opts } {
+ if {[require_portlist portlist "yes"] || ([prefix_unwritable] && ![macports::global_option_isset ports_dryrun])} {
+ return 1
+ }
+
+ # shared depscache for all ports in the list
+ array set depscache {}
+ set status 0
+ foreachport $portlist {
+ if {![info exists depscache(port:$portname)]} {
+ set status [macports::upgrade $portname "port:$portname" [array get requested_variations] [array get options] depscache]
+ # status 2 means the port was not found in the index,
+ # status 3 means the port is not installed
+ if {$status != 0 && $status != 2 && $status != 3 && ![macports::ui_isset ports_processall]} {
+ break
+ }
+ }
+ }
+
+ if {$status != 0 && $status != 2 && $status != 3} {
+ print_tickets_url
+ } elseif {$status == 0} {
+ array set options $opts
+ if {![info exists options(ports_upgrade_no-rev-upgrade)] && ${macports::revupgrade_autorun} && ![macports::global_option_isset ports_dryrun]} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+proc action_doctor { action portlist opts } {
+<<<<<<< HEAD
+ macports::doctor_main
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+ macports::doctor_main $opts
+>>>>>>> svn
+ return 0
+}
+
+proc action_reclaim { action portlist opts } {
+<<<<<<< HEAD
+=======
+ if {[prefix_unwritable]} {
+ return 1
+ }
+>>>>>>> svn
+ macports::reclaim_main
+ return 0
+}
+
+proc action_revupgrade { action portlist opts } {
+ set status [macports::revupgrade $opts]
+ if {$status != 0} {
+ print_tickets_url
+ }
+ return $status
+}
+
+
+proc action_version { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Version: "
+ }
+ puts [macports::version]
+ return 0
+}
+
+
+proc action_platform { action portlist opts } {
+ if {![macports::ui_isset ports_quiet]} {
+ puts -nonewline "Platform: "
+ }
+ puts "${macports::os_platform} ${macports::os_major} ${macports::os_arch}"
+ return 0
+}
+
+
+proc action_dependents { action portlist opts } {
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set ilist {}
+
+ registry::open_dep_map
+
+ set status 0
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [registry::installed $portname $composite_version]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "$result" 1 status
+ } else {
+ # choose the active version if there is one
+ set index 0
+ foreach i $ilist {
+ if {[lindex $i 4]} {
+ set found 1
+ break
+ }
+ incr index
+ }
+ if {![info exists found]} {
+ set index 0
+ }
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist $index 0]
+ set iversion [lindex $ilist $index 1]
+ set irevision [lindex $ilist $index 2]
+ set ivariants [lindex $ilist $index 3]
+ }
+
+ set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
+ if { [llength $deplist] > 0 } {
+ if {$action eq "rdependents"} {
+ set toplist $deplist
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ }
+ set dependentsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ ui_notice "The following ports are dependent on ${portname}:"
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex $cur_port 2]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_rdependents_full)] && [string is true -strict $options(ports_rdependents_full)])} {
+ puts "${spaces}${cur_portname}"
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists dependentsof($cur_portname)]} {
+ lappend portstack $dependentsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ } else {
+ foreach dep $deplist {
+ set depport [lindex $dep 2]
+ if {[macports::ui_isset ports_quiet]} {
+ ui_msg "$depport"
+ } elseif {![macports::ui_isset ports_verbose]} {
+ ui_msg "$depport depends on $portname"
+ } else {
+ ui_msg "$depport depends on $portname (by [lindex $dep 1]:)"
+ }
+ }
+ }
+ } else {
+ ui_notice "$portname has no dependents."
+ }
+ }
+ return $status
+}
+
+
+proc action_deps { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ set separator ""
+
+ foreachport $portlist {
+ if {[info exists options(ports_${action}_no-build)] && [string is true -strict $options(ports_${action}_no-build)]} {
+ set deptypes {depends_lib depends_run}
+ } else {
+ set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+ }
+
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {mportlookup $portname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ } elseif {$porturl ne "file://."} {
+ # Extract the portdir from porturl and use it to search PortIndex.
+ # Only the last two elements of the path (porturl) make up the
+ # portdir.
+ set portdir [file split [macports::getportdir $porturl]]
+ set lsize [llength $portdir]
+ set portdir \
+ [file join [lindex $portdir [expr {$lsize - 2}]] \
+ [lindex $portdir [expr {$lsize - 1}]]]
+ if {[catch {mportsearch $portdir no exact portdir} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Portdir $portdir not found" 1 status
+ }
+ set matchindex [lsearch -exact -nocase $result $portname]
+ if {$matchindex != -1} {
+ array set portinfo [lindex $result [incr matchindex]]
+ } else {
+ ui_warn "Portdir $portdir doesn't seem to belong to portname $portname"
+ array set portinfo [lindex $result 1]
+ }
+ }
+
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ # Add any global_variations to the variations
+ # specified for the port, so we get dependencies right
+ array unset merged_variations
+ array set merged_variations [array get variations]
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ } elseif {![info exists portinfo]} {
+ ui_warn "port ${action} --index does not work with the 'current' pseudo-port"
+ continue
+ }
+ set portname $portinfo(name)
+
+ set deplist {}
+ set deps_output {}
+ set ndeps 0
+ array set labeldict {depends_fetch Fetch depends_extract Extract depends_build Build depends_lib Library depends_run Runtime}
+ # get list of direct deps
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ if {$action eq "rdeps" || [macports::ui_isset ports_verbose]} {
+ foreach dep $portinfo($type) {
+ lappend deplist $dep
+ }
+ } else {
+ foreach dep $portinfo($type) {
+ lappend deplist [lindex [split $dep :] end]
+ }
+ }
+ if {$action eq "deps"} {
+ set label "$labeldict($type) Dependencies"
+ lappend deps_output [wraplabel $label [join $deplist ", "] 0 [string repeat " " 22]]
+ incr ndeps [llength $deplist]
+ set deplist {}
+ }
+ }
+ }
+
+ set version $portinfo(version)
+ set revision $portinfo(revision)
+ if {[info exists portinfo(canonical_active_variants)]} {
+ set variants $portinfo(canonical_active_variants)
+ } else {
+ set variants {}
+ }
+
+ puts -nonewline $separator
+ if {$action eq "deps"} {
+ if {$ndeps == 0} {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ } else {
+ ui_notice "Full Name: $portname @${version}_${revision}${variants}"
+ puts [join $deps_output "\n"]
+ }
+ set separator "--\n"
+ continue
+ }
+
+ set toplist $deplist
+ # gather all the deps
+ while 1 {
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex [split $dep :] end]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+
+ # look up the dep
+ if {[catch {mportlookup $depname} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "lookup of portname $depname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $depname not found" 1 status
+ }
+ array unset portinfo
+ array set portinfo [lindex $result 1]
+ set porturl $portinfo(porturl)
+ set options(subport) $portinfo(name)
+
+ # open the portfile if requested
+ if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
+ if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ }
+
+ # get list of the dep's deps
+ set rdeplist {}
+ foreach type $deptypes {
+ if {[info exists portinfo($type)]} {
+ foreach rdep $portinfo($type) {
+ lappend rdeplist $rdep
+ lappend newlist $rdep
+ }
+ }
+ }
+ set depsof($depname) $rdeplist
+ }
+ }
+ if {[llength $newlist] > 0} {
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ set portstack [list $toplist]
+ set pos_stack [list 0]
+ array unset seen
+ if {[llength $toplist] > 0} {
+ ui_notice "The following ports are dependencies of $portname @${version}_${revision}${variants}:"
+ } else {
+ ui_notice "$portname @${version}_${revision}${variants} has no dependencies."
+ }
+ while 1 {
+ set cur_portlist [lindex $portstack end]
+ set cur_pos [lindex $pos_stack end]
+ if {$cur_pos >= [llength $cur_portlist]} {
+ set portstack [lreplace $portstack end end]
+ set pos_stack [lreplace $pos_stack end end]
+ if {[llength $portstack] <= 0} {
+ break
+ } else {
+ continue
+ }
+ }
+ set cur_port [lindex $cur_portlist $cur_pos]
+ set cur_portname [lindex [split $cur_port :] end]
+ set spaces [string repeat " " [expr {[llength $pos_stack] * 2}]]
+ if {![info exists seen($cur_portname)] || ([info exists options(ports_${action}_full)] && [string is true -strict $options(ports_${action}_full)])} {
+ if {[macports::ui_isset ports_verbose]} {
+ puts "${spaces}${cur_port}"
+ } else {
+ puts "${spaces}${cur_portname}"
+ }
+ set seen($cur_portname) 1
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ if {[info exists depsof($cur_portname)]} {
+ lappend portstack $depsof($cur_portname)
+ lappend pos_stack 0
+ }
+ continue
+ }
+ incr cur_pos
+ set pos_stack [lreplace $pos_stack end end $cur_pos]
+ }
+ set separator "--\n"
+ }
+ return $status
+}
+
+
+proc action_uninstall { action portlist opts } {
+ set status 0
+ if {[macports::global_option_isset port_uninstall_old]} {
+ # if -u then uninstall all inactive ports
+ # (union these to any other ports user has in the port list)
+ set portlist [opUnion $portlist [get_inactive_ports]]
+ } else {
+ # Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ }
+ if {[prefix_unwritable]} {
+ return 1
+ }
+
+ set portlist [portlist_sortdependents $portlist]
+
+ foreachport $portlist {
+ if {![registry::entry_exists_for_name $portname]} {
+ # if the code path arrives here the port either isn't installed, or
+ # it doesn't exist at all. We can't be sure, but we can check the
+ # portindex whether a port by that name exists (in which case not
+ # uninstalling it is probably no problem). If there is no port by
+ # that name, alert the user in case of typos.
+ ui_info "$portname is not installed"
+ if {[catch {set res [mportlookup $portname]} result] || [llength $res] == 0} {
+ ui_warn "no such port: $portname, skipping uninstall"
+ }
+ continue
+ }
+ set composite_version [composite_version $portversion [array get variations]]
+ if {![info exists options(ports_uninstall_no-exec)]
+ && ![catch {set ilist [registry::installed $portname $composite_version]}]
+ && [llength $ilist] == 1} {
+
+ set i [lindex $ilist 0]
+ set iactive [lindex $i 4]
+ set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
+ if {[registry::run_target $regref uninstall [array get options]]} {
+ continue
+ }
+ }
+
+ if { [catch {registry_uninstall::uninstall_composite $portname $composite_version [array get options]} result] } {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port uninstall failed: $result" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_installed { action portlist opts } {
+ global private_options
+ set status 0
+ set restrictedList 0
+ set ilist {}
+
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreachport $portlist {
+ set composite_version [composite_version $portversion [array get variations]]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port installed failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+ if { [llength $ilist] > 0 } {
+ ui_notice "The following ports are currently installed:"
+ foreach i [portlist_sortint $ilist] {
+ set iname [lindex $i 0]
+ set iversion [lindex $i 1]
+ set irevision [lindex $i 2]
+ set ivariants [lindex $i 3]
+ set iactive [lindex $i 4]
+ set extra ""
+ set nvariants ""
+ if {[macports::ui_isset ports_verbose]} {
+ set regref [registry::open_entry $iname $iversion $irevision $ivariants [lindex $i 5]]
+ set nvariants [registry::property_retrieve $regref negated_variants]
+ if {$nvariants == 0} {
+ set nvariants ""
+ }
+ set os_platform [registry::property_retrieve $regref os_platform]
+ set os_major [registry::property_retrieve $regref os_major]
+ set archs [registry::property_retrieve $regref archs]
+ if {$os_platform != 0 && $os_platform ne "" && $os_major != 0 && $os_major ne ""} {
+ append extra " platform='$os_platform $os_major'"
+ }
+ if {$archs != 0 && $archs ne ""} {
+ append extra " archs='$archs'"
+ }
+ }
+ if { $iactive == 0 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
+ } elseif { $iactive == 1 } {
+ puts " $iname @${iversion}_${irevision}${ivariants}${nvariants} (active)${extra}"
+ }
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are installed."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_outdated { action portlist opts } {
+ global private_options
+ set status 0
+
+ # If port names were supplied, limit ourselves to those ports, else check all installed ports
+ set ilist {}
+ set restrictedList 0
+ if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
+ set restrictedList 1
+ foreach portspec $portlist {
+ array set port $portspec
+ set portname $port(name)
+ set composite_version [composite_version $port(version) $port(variants)]
+ if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
+ if {![string match "* not registered as installed." $result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "port outdated failed: $result" 1 status
+ }
+ }
+ }
+ } else {
+ if { [catch {set ilist [registry::installed]} result] } {
+ if {$result ne "Registry error: No ports registered as installed."} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "port installed failed: $result"
+ set status 1
+ }
+ }
+ }
+
+ set num_outdated 0
+ if { [llength $ilist] > 0 } {
+ foreach i [portlist_sortint $ilist] {
+
+ # Get information about the installed port
+ set portname [lindex $i 0]
+ set installed_version [lindex $i 1]
+ set installed_revision [lindex $i 2]
+ set installed_compound "${installed_version}_${installed_revision}"
+
+ set is_active [lindex $i 4]
+ if {$is_active == 0} {
+ continue
+ }
+ set installed_epoch [lindex $i 5]
+
+ # Get info about the port from the index
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ if {[macports::ui_isset ports_debug]} {
+ puts "$portname ($installed_compound is installed; the port was not found in the port index)"
+ }
+ continue
+ }
+ array unset portinfo
+ array set portinfo [lindex $res 1]
+
+ # Get information about latest available version and revision
+ if {![info exists portinfo(version)]} {
+ ui_warn "$portname has no version field"
+ continue
+ }
+ set latest_version $portinfo(version)
+ set latest_revision 0
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ set latest_revision $portinfo(revision)
+ }
+ set latest_compound "${latest_version}_${latest_revision}"
+ set latest_epoch 0
+ if {[info exists portinfo(epoch)]} {
+ set latest_epoch $portinfo(epoch)
+ }
+
+ # Compare versions, first checking epoch, then version, then revision
+ set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
+ set comp_result [vercmp $installed_version $latest_version]
+ if { $comp_result == 0 } {
+ set comp_result [expr {$installed_revision - $latest_revision}]
+ }
+ set reason ""
+ if {$epoch_comp_result != 0 && $installed_version != $latest_version} {
+ if {($comp_result >= 0 && $epoch_comp_result < 0) || ($comp_result <= 0 && $epoch_comp_result > 0)} {
+ set reason { (epoch $installed_epoch $relation $latest_epoch)}
+ }
+ set comp_result $epoch_comp_result
+ } elseif {$comp_result == 0} {
+ set regref [registry::open_entry $portname $installed_version $installed_revision [lindex $i 3] $installed_epoch]
+ set os_platform_installed [registry::property_retrieve $regref os_platform]
+ set os_major_installed [registry::property_retrieve $regref os_major]
+ if {$os_platform_installed ne "" && $os_platform_installed != 0
+ && $os_major_installed ne "" && $os_major_installed != 0
+ && ($os_platform_installed != ${macports::os_platform} || $os_major_installed != ${macports::os_major})} {
+ set comp_result -1
+ set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
+ }
+ }
+
+ # Report outdated (or, for verbose, predated) versions
+ if { $comp_result != 0 } {
+
+ # Form a relation between the versions
+ set flag ""
+ if { $comp_result > 0 } {
+ set relation ">"
+ set flag "!"
+ } else {
+ set relation "<"
+ }
+
+ # Emit information
+ if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
+
+ if {$num_outdated == 0} {
+ ui_notice "The following installed ports are outdated:"
+ }
+ incr num_outdated
+
+ puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
+ }
+
+ }
+ }
+
+ if {$num_outdated == 0} {
+ ui_notice "No installed ports are outdated."
+ }
+ } elseif { $restrictedList } {
+ ui_notice "None of the specified ports are outdated."
+ } else {
+ ui_notice "No ports are installed."
+ }
+
+ return $status
+}
+
+
+proc action_contents { action portlist opts } {
+ global global_options
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {[info exists global_options(ports_contents_size)]} {
+ set units {}
+ if {[info exists global_options(ports_contents_units)]} {
+ set units [complete_size_units $global_options(ports_contents_units)]
+ }
+ set outstring {[format "%12s $file" [filesize $file $units]]}
+ } else {
+ set outstring { $file}
+ }
+
+ foreachport $portlist {
+ if { ![catch {set ilist [registry::installed $portname]} result] } {
+ # set portname again since the one we were passed may not have had the correct case
+ set portname [lindex $ilist 0 0]
+ }
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ ui_notice "Port $portname contains:"
+ foreach file $files {
+ puts [subst $outstring]
+ }
+ } else {
+ ui_notice "Port $portname does not contain any files or is not active."
+ }
+ } else {
+ ui_notice "Port $portname is not installed."
+ }
+ }
+ registry::close_file_map
+
+ return 0
+}
+
+# expand abbreviations of size units
+proc complete_size_units {units} {
+ if {$units eq "K" || $units eq "Ki"} {
+ return "KiB"
+ } elseif {$units eq "k"} {
+ return "kB"
+ } elseif {$units eq "Mi"} {
+ return "MiB"
+ } elseif {$units eq "M"} {
+ return "MB"
+ } elseif {$units eq "Gi"} {
+ return "GiB"
+ } elseif {$units eq "G"} {
+ return "GB"
+ } else {
+ return $units
+ }
+}
+
+# Show space used by the given ports' files
+proc action_space {action portlist opts} {
+ global global_options
+ require_portlist portlist
+
+ set units {}
+ if {[info exists global_options(ports_space_units)]} {
+ set units [complete_size_units $global_options(ports_space_units)]
+ }
+ set spaceall 0.0
+ foreachport $portlist {
+ set space 0.0
+ set files [registry::port_registered $portname]
+ if { $files != 0 } {
+ if { [llength $files] > 0 } {
+ foreach file $files {
+ catch {
+ set space [expr {$space + [file size $file]}]
+ }
+ }
+ if {![info exists options(ports_space_total)] || $options(ports_space_total) ne "yes"} {
+ set msg "[bytesize $space $units] $portname"
+ if { $portversion != {} } {
+ append msg " @$portversion"
+ }
+ puts $msg
+ }
+ set spaceall [expr {$space + $spaceall}]
+ } else {
+ puts stderr "Port $portname does not contain any file or is not active."
+ }
+ } else {
+ puts stderr "Port $portname is not installed."
+ }
+ }
+ if {[llength $portlist] > 1 || ([info exists options(ports_space_total)] && $options(ports_space_total) eq "yes")} {
+ puts "[bytesize $spaceall $units] total"
+ }
+ return 0
+}
+
+proc action_variants { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ if {$porturl eq ""} {
+ # look up port
+ if {[catch {mportlookup $portname} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $result] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+
+ array set portinfo [lindex $result 1]
+
+ set porturl $portinfo(porturl)
+ set portdir $portinfo(portdir)
+ }
+
+ if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
+ ui_debug "$::errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ array unset portinfo
+ array set portinfo [mportinfo $mport]
+ mportclose $mport
+ if {[info exists portdir]} {
+ set portinfo(portdir) $portdir
+ }
+ } elseif {![info exists portinfo]} {
+ ui_warn "port variants --index does not work with 'current' pseudo-port"
+ continue
+ }
+
+ # set portname again since the one we were passed may not have had the correct case
+ set portname $portinfo(name)
+
+ # if this fails the port doesn't have any variants
+ if {![info exists portinfo(variants)]} {
+ ui_notice "$portname has no variants"
+ } else {
+ array unset vinfo
+ # Use the new format if it exists.
+ if {[info exists portinfo(vinfo)]} {
+ array set vinfo $portinfo(vinfo)
+ # Otherwise fall back to the old format.
+ } elseif {[info exists portinfo(variant_desc)]} {
+ array set vdescriptions $portinfo(variant_desc)
+ }
+
+ # print out all the variants
+ ui_notice "$portname has the variants:"
+ foreach v [lsort $portinfo(variants)] {
+ unset -nocomplain vconflicts vdescription vrequires
+ set varmodifier " "
+ # Retrieve variants' information from the new format.
+ if {[info exists vinfo]} {
+ array unset variant
+ array set variant $vinfo($v)
+
+ # Retrieve conflicts, description, is_default, and
+ # vrequires.
+ if {[info exists variant(conflicts)]} {
+ set vconflicts $variant(conflicts)
+ }
+ if {[info exists variant(description)]} {
+ set vdescription $variant(description)
+ }
+
+ # XXX Keep these varmodifiers in sync with action_info, or create a wrapper for it
+ if {[info exists variations($v)]} {
+ set varmodifier " $variations($v)"
+ } elseif {[info exists global_variations($v)]} {
+ # selected by variants.conf, prefixed with (+)/(-)
+ set varmodifier "($global_variations($v))"
+ } elseif {[info exists variant(is_default)]} {
+ set varmodifier "\[$variant(is_default)\]"
+ }
+ if {[info exists variant(requires)]} {
+ set vrequires $variant(requires)
+ }
+ # Retrieve variants' information from the old format,
+ # which only consists of the description.
+ } elseif {[info exists vdescriptions($v)]} {
+ set vdescription $vdescriptions($v)
+ }
+
+ if {[info exists vdescription]} {
+ puts [wraplabel "$varmodifier$v" [string trim $vdescription] 0 [string repeat " " [expr 5 + [string length $v]]]]
+ } else {
+ puts "$varmodifier$v"
+ }
+ if {[info exists vconflicts]} {
+ puts " * conflicts with [string trim $vconflicts]"
+ }
+ if {[info exists vrequires]} {
+ puts " * requires [string trim $vrequires]"
+ }
+ }
+ }
+ }
+
+ return $status
+}
+
+
+proc action_search { action portlist opts } {
+ global private_options global_options
+ set status 0
+ if {![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ ui_error "You must specify a search pattern"
+ return 1
+ }
+
+ # Copy global options as we are going to modify the array
+ array set options [array get global_options]
+
+ if {[info exists options(ports_search_depends)] && $options(ports_search_depends) eq "yes"} {
+ array unset options ports_search_depends
+ set options(ports_search_depends_fetch) yes
+ set options(ports_search_depends_extract) yes
+ set options(ports_search_depends_build) yes
+ set options(ports_search_depends_lib) yes
+ set options(ports_search_depends_run) yes
+ }
+
+ # Array to hold given filters
+ array set filters {}
+ # Default matchstyle
+ set filter_matchstyle "none"
+ set filter_case no
+ foreach { option } [array names options ports_search_*] {
+ set opt [string range $option 13 end]
+
+ if { $options($option) ne "yes" } {
+ continue
+ }
+ switch -- $opt {
+ exact -
+ glob {
+ set filter_matchstyle $opt
+ continue
+ }
+ regex {
+ set filter_matchstyle regexp
+ continue
+ }
+ case-sensitive {
+ set filter_case yes
+ continue
+ }
+ line {
+ continue
+ }
+ }
+
+ set filters($opt) "yes"
+ }
+ # Set default search filter if none was given
+ if { [array size filters] == 0 } {
+ set filters(name) "yes"
+ set filters(description) "yes"
+ }
+
+ set separator ""
+ foreach portname $portlist {
+ puts -nonewline $separator
+
+ set searchstring $portname
+ set matchstyle $filter_matchstyle
+ if {$matchstyle eq "none"} {
+ # Guess if the given string was a glob expression, if not do a substring search
+ if {[string first "*" $portname] == -1 && [string first "?" $portname] == -1} {
+ set searchstring "*$portname*"
+ }
+ set matchstyle glob
+ }
+
+ set res {}
+ set portfound 0
+ foreach { opt } [array get filters] {
+ # Map from friendly name
+ set opt [map_friendly_field_names $opt]
+
+ if {[catch {eval set matches \[mportsearch \$searchstring $filter_case \$matchstyle $opt\]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for name $portname failed: $result" 1 status
+ }
+
+ set tmp {}
+ foreach {name info} $matches {
+ add_to_portlist tmp [concat [list name $name] $info]
+ }
+ set res [opUnion $res $tmp]
+ }
+ set res [portlist_sort $res]
+
+ set joiner ""
+ foreach info $res {
+ array unset portinfo
+ array set portinfo $info
+
+ # XXX is this the right place to verify an entry?
+ if {![info exists portinfo(name)]} {
+ puts stderr "Invalid port entry, missing portname"
+ continue
+ }
+ if {![info exists portinfo(description)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing description"
+ continue
+ }
+ if {![info exists portinfo(version)]} {
+ puts stderr "Invalid port entry for $portinfo(name), missing version"
+ continue
+ }
+
+ if {[macports::ui_isset ports_quiet]} {
+ puts $portinfo(name)
+ } else {
+ if {[info exists options(ports_search_line)]
+ && $options(ports_search_line) eq "yes"} {
+ # check for ports without category, e.g. replaced_by stubs
+ if {[info exists portinfo(categories)]} {
+ puts "$portinfo(name)\t$portinfo(version)\t$portinfo(categories)\t$portinfo(description)"
+ } else {
+ # keep two consecutive tabs in order to provide consistent columns' content
+ puts "$portinfo(name)\t$portinfo(version)\t\t$portinfo(description)"
+ }
+ } else {
+ puts -nonewline $joiner
+
+ puts -nonewline "$portinfo(name) @$portinfo(version)"
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ puts -nonewline "_$portinfo(revision)"
+ }
+ if {[info exists portinfo(categories)]} {
+ puts -nonewline " ([join $portinfo(categories) ", "])"
+ }
+ puts ""
+ puts [wrap [join $portinfo(description)] 0 [string repeat " " 4]]
+ }
+ }
+
+ set joiner "\n"
+ set portfound 1
+ }
+ if { !$portfound } {
+ ui_notice "No match for $portname found"
+ } elseif {[llength $res] > 1} {
+ if {(![info exists global_options(ports_search_line)]
+ || $global_options(ports_search_line) ne "yes")} {
+ ui_notice "\nFound [llength $res] ports."
+ }
+ }
+
+ set separator "--\n"
+ }
+
+ array unset options
+ array unset filters
+
+ return $status
+}
+
+
+proc action_list { action portlist opts } {
+ global private_options
+ set status 0
+
+ # Default to list all ports if no portnames are supplied
+ if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
+ add_to_portlist portlist [list name "-all-"]
+ }
+
+ foreachport $portlist {
+ if {$portname eq "-all-"} {
+ if {[catch {set res [mportlistall]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "listing all ports failed: $result" 1 status
+ }
+ } else {
+ set search_string [regex_pat_sanitize $portname]
+ if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "search for portname $search_string failed: $result" 1 status
+ }
+ }
+
+ foreach {name array} $res {
+ array unset portinfo
+ array set portinfo $array
+ set outdir ""
+ if {[info exists portinfo(portdir)]} {
+ set outdir $portinfo(portdir)
+ }
+ puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_echo { action portlist opts } {
+ global global_options
+
+ # Simply echo back the port specs given to this command
+ foreachport $portlist {
+ if {![macports::ui_isset ports_quiet]} {
+ set opts {}
+ foreach { key value } [array get options] {
+ if {![info exists global_options($key)]} {
+ lappend opts "$key=$value"
+ }
+ }
+
+ set composite_version [composite_version $portversion [array get variations] 1]
+ if { $composite_version ne "" } {
+ set ver_field "@$composite_version"
+ } else {
+ set ver_field ""
+ }
+ puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
+ } else {
+ puts "$portname"
+ }
+ }
+
+ return 0
+}
+
+
+proc action_portcmds { action portlist opts } {
+ # Operations on the port's directory and Portfile
+ global env boot_env current_portdir
+
+ array set local_options $opts
+
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ set portname $portinfo(name)
+ }
+
+
+ # Calculate portdir, porturl, and portfile from initial porturl
+ set portdir [file normalize [macports::getportdir $porturl]]
+ set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
+ set portfile "${portdir}/Portfile"
+
+ # Now execute the specific action
+ if {[file readable $portfile]} {
+ switch -- $action {
+ cat {
+ # Copy the portfile to standard output
+ set f [open $portfile RDONLY]
+ while { ![eof $f] } {
+ puts -nonewline [read $f 4096]
+ }
+ close $f
+ }
+
+ edit {
+ # Edit the port's portfile with the user's editor
+
+ # Restore our entire environment from start time.
+ # We need it to evaluate the editor, and the editor
+ # may want stuff from it as well, like TERM.
+ array unset env_save; array set env_save [array get env]
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get boot_env]
+
+ # Find an editor to edit the portfile
+ set editor ""
+ set editor_var "ports_${action}_editor"
+ if {[info exists local_options($editor_var)]} {
+ set editor [join $local_options($editor_var)]
+ } else {
+ foreach ed { MP_EDITOR VISUAL EDITOR } {
+ if {[info exists env($ed)]} {
+ set editor $env($ed)
+ break
+ }
+ }
+ }
+
+ # Use a reasonable canned default if no editor specified or set in env
+ if { $editor eq "" } { set editor "/usr/bin/vi" }
+
+ # Invoke the editor
+ if {[catch {eval exec >@stdout <@stdin 2>@stderr $editor {$portfile}} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke editor $editor: $result" 1 status
+ }
+
+ # Restore internal MacPorts environment
+ array unset env *
+ if {${macports::macosx_version} eq "10.5"} {
+ unsetenv *
+ }
+ array set env [array get env_save]
+ }
+
+ dir {
+ # output the path to the port's directory
+ puts $portdir
+ }
+
+ work {
+ # output the path to the port's work directory
+ set workpath [macports::getportworkpath_from_portdir $portdir $portname]
+ if {[file exists $workpath]} {
+ puts $workpath
+ }
+ }
+
+ cd {
+ # Change to the port's directory, making it the default
+ # port for any future commands
+ set current_portdir $portdir
+ }
+
+ url {
+ # output the url of the port's directory, suitable to feed back in later as a port descriptor
+ puts $porturl
+ }
+
+ file {
+ # output the path to the port's portfile
+ puts $portfile
+ }
+
+ logfile {
+ set logfile [file join [macports::getportlogpath $portdir $portname] "main.log"]
+ if {[file isfile $logfile]} {
+ puts $logfile
+ } else {
+ ui_error "Log file not found for port in $portdir"
+ }
+ }
+
+ gohome {
+ set homepage ""
+
+ # Get the homepage as read from PortIndex
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+
+ # If not available, get the homepage for the port by opening the Portfile
+ if {$homepage eq "" && ![catch {set ctx [mportopen $porturl]} result]} {
+ array set portinfo [mportinfo $ctx]
+ if {[info exists portinfo(homepage)]} {
+ set homepage $portinfo(homepage)
+ }
+ mportclose $ctx
+ }
+
+ # Try to open a browser to the homepage for the given port
+ if { $homepage ne "" } {
+ if {[catch {system "${macports::autoconf::open_path} '$homepage'"} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "unable to invoke browser using ${macports::autoconf::open_path}: $result" 1 status
+ }
+ } else {
+ ui_error [format "No homepage for %s" $portname]
+ }
+ }
+ }
+ } else {
+ break_softcontinue "Could not read $portfile" 1 status
+ }
+ }
+
+ return $status
+}
+
+
+proc action_sync { action portlist opts } {
+ global global_options
+
+ set status 0
+ if {[catch {mportsync [array get global_options]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_msg "port sync failed: $result"
+ set status 1
+ }
+
+ return $status
+}
+
+
+proc action_target { action portlist opts } {
+ global global_variations
+ set status 0
+ if {[require_portlist portlist]} {
+ return 1
+ }
+ if {($action eq "install" || $action eq "archive") && [prefix_unwritable] && ![macports::global_option_isset ports_dryrun]} {
+ return 1
+ }
+ foreachport $portlist {
+ array unset portinfo
+ # If we have a url, use that, since it's most specific
+ # otherwise try to map the portname to a url
+ if {$porturl eq ""} {
+ # Verify the portname, getting portinfo to map to a porturl
+ if {[catch {set res [mportlookup $portname]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "lookup of portname $portname failed: $result" 1 status
+ }
+ if {[llength $res] < 2} {
+ # don't error for ports that are installed but not in the tree
+ if {[registry::entry_exists_for_name $portname]} {
+ ui_warn "Skipping $portname (not in the ports tree)"
+ continue
+ } else {
+ break_softcontinue "Port $portname not found" 1 status
+ }
+ }
+ array set portinfo [lindex $res 1]
+ set porturl $portinfo(porturl)
+ }
+
+ # use existing variants iff none were explicitly requested
+ if {[array get requested_variations] eq "" && [array get variations] ne ""} {
+ array unset requested_variations
+ array set requested_variations [array get variations]
+ }
+
+ # Add any global_variations to the variations
+ # specified for the port
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists requested_variations($variation)] } {
+ set requested_variations($variation) $value
+ }
+ }
+
+ # If version was specified, save it as a version glob for use
+ # in port actions (e.g. clean).
+ if {[string length $portversion]} {
+ set options(ports_version_glob) $portversion
+ }
+ # if installing, mark the port as explicitly requested
+ if {$action eq "install"} {
+ if {![info exists options(ports_install_unrequested)]} {
+ set options(ports_requested) 1
+ }
+ # we actually activate as well
+ set target activate
+ } elseif {$action eq "archive"} {
+ set target install
+ } else {
+ set target $action
+ }
+ if {![info exists options(subport)]} {
+ if {[info exists portinfo(name)]} {
+ set options(subport) $portinfo(name)
+ } else {
+ set options(subport) $portname
+ }
+ }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get requested_variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to open port: $result" 1 status
+ }
+ if {[catch {set result [mportexec $workername $target]} result]} {
+ global errorInfo
+ mportclose $workername
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $result" 1 status
+ }
+
+ mportclose $workername
+
+ # Process any error that wasn't thrown and handled already
+ if {$result} {
+ print_tickets_url
+ break_softcontinue "Processing of port $portname failed" 1 status
+ }
+ }
+
+ if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
+ array set options $opts
+ if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
+ set status [action_revupgrade $action $portlist $opts]
+ }
+ }
+
+ return $status
+}
+
+
+proc action_exit { action portlist opts } {
+ # Return a semaphore telling the main loop to quit
+ return -999
+}
+
+
+##########################################
+# Command Parsing
+##########################################
+proc moreargs {} {
+ global cmd_argn cmd_argc
+ return [expr {$cmd_argn < $cmd_argc}]
+}
+
+
+proc lookahead {} {
+ global cmd_argn cmd_argc cmd_argv
+ if {$cmd_argn < $cmd_argc} {
+ return [lindex $cmd_argv $cmd_argn]
+ } else {
+ return _EOF_
+ }
+}
+
+
+proc advance {} {
+ global cmd_argn
+ incr cmd_argn
+}
+
+
+proc match s {
+ if {[lookahead] == $s} {
+ advance
+ return 1
+ }
+ return 0
+}
+
+# action_array specifies which action to run on the given command
+# and if the action wants an expanded portlist.
+# The value is a list of the form {action expand},
+# where action is a string and expand a value:
+# 0 none Does not expect any text argument
+# 1 strings Expects some strings as text argument
+# 2 ports Wants an expanded list of ports as text argument
+global action_array
+
+# Define global constants
+const ACTION_ARGS_NONE 0
+const ACTION_ARGS_STRINGS 1
+const ACTION_ARGS_PORTS 2
+
+array set action_array [list \
+ usage [list action_usage [ACTION_ARGS_STRINGS]] \
+ help [list action_help [ACTION_ARGS_STRINGS]] \
+ \
+ echo [list action_echo [ACTION_ARGS_PORTS]] \
+ \
+ info [list action_info [ACTION_ARGS_PORTS]] \
+ location [list action_location [ACTION_ARGS_PORTS]] \
+ notes [list action_notes [ACTION_ARGS_PORTS]] \
+ provides [list action_provides [ACTION_ARGS_STRINGS]] \
+ log [list action_log [ACTION_ARGS_PORTS]] \
+ \
+ activate [list action_activate [ACTION_ARGS_PORTS]] \
+ deactivate [list action_deactivate [ACTION_ARGS_PORTS]] \
+ \
+ select [list action_select [ACTION_ARGS_STRINGS]] \
+ \
+ sync [list action_sync [ACTION_ARGS_NONE]] \
+ selfupdate [list action_selfupdate [ACTION_ARGS_NONE]] \
+ \
+ setrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ unsetrequested [list action_setrequested [ACTION_ARGS_PORTS]] \
+ \
+ upgrade [list action_upgrade [ACTION_ARGS_PORTS]] \
+ rev-upgrade [list action_revupgrade [ACTION_ARGS_NONE]] \
+ reclaim [list action_reclaim [ACTION_ARGS_NONE]] \
+ doctor [list action_doctor [ACTION_ARGS_NONE]] \
+ \
+ version [list action_version [ACTION_ARGS_NONE]] \
+ platform [list action_platform [ACTION_ARGS_NONE]] \
+ \
+ uninstall [list action_uninstall [ACTION_ARGS_PORTS]] \
+ \
+ installed [list action_installed [ACTION_ARGS_PORTS]] \
+ outdated [list action_outdated [ACTION_ARGS_PORTS]] \
+ contents [list action_contents [ACTION_ARGS_PORTS]] \
+ space [list action_space [ACTION_ARGS_PORTS]] \
+ dependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ rdependents [list action_dependents [ACTION_ARGS_PORTS]] \
+ deps [list action_deps [ACTION_ARGS_PORTS]] \
+ rdeps [list action_deps [ACTION_ARGS_PORTS]] \
+ variants [list action_variants [ACTION_ARGS_PORTS]] \
+ \
+ search [list action_search [ACTION_ARGS_STRINGS]] \
+ list [list action_list [ACTION_ARGS_PORTS]] \
+ \
+ edit [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cat [list action_portcmds [ACTION_ARGS_PORTS]] \
+ dir [list action_portcmds [ACTION_ARGS_PORTS]] \
+ work [list action_portcmds [ACTION_ARGS_PORTS]] \
+ cd [list action_portcmds [ACTION_ARGS_PORTS]] \
+ url [list action_portcmds [ACTION_ARGS_PORTS]] \
+ file [list action_portcmds [ACTION_ARGS_PORTS]] \
+ logfile [list action_portcmds [ACTION_ARGS_PORTS]] \
+ gohome [list action_portcmds [ACTION_ARGS_PORTS]] \
+ \
+ fetch [list action_target [ACTION_ARGS_PORTS]] \
+ checksum [list action_target [ACTION_ARGS_PORTS]] \
+ extract [list action_target [ACTION_ARGS_PORTS]] \
+ patch [list action_target [ACTION_ARGS_PORTS]] \
+ configure [list action_target [ACTION_ARGS_PORTS]] \
+ build [list action_target [ACTION_ARGS_PORTS]] \
+ destroot [list action_target [ACTION_ARGS_PORTS]] \
+ install [list action_target [ACTION_ARGS_PORTS]] \
+ clean [list action_target [ACTION_ARGS_PORTS]] \
+ test [list action_target [ACTION_ARGS_PORTS]] \
+ lint [list action_target [ACTION_ARGS_PORTS]] \
+ livecheck [list action_target [ACTION_ARGS_PORTS]] \
+ distcheck [list action_target [ACTION_ARGS_PORTS]] \
+ mirror [list action_target [ACTION_ARGS_PORTS]] \
+ load [list action_target [ACTION_ARGS_PORTS]] \
+ unload [list action_target [ACTION_ARGS_PORTS]] \
+ distfiles [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ archivefetch [list action_target [ACTION_ARGS_PORTS]] \
+ archive [list action_target [ACTION_ARGS_PORTS]] \
+ unarchive [list action_target [ACTION_ARGS_PORTS]] \
+ dmg [list action_target [ACTION_ARGS_PORTS]] \
+ mdmg [list action_target [ACTION_ARGS_PORTS]] \
+ dpkg [list action_target [ACTION_ARGS_PORTS]] \
+ mpkg [list action_target [ACTION_ARGS_PORTS]] \
+ pkg [list action_target [ACTION_ARGS_PORTS]] \
+ portpkg [list action_target [ACTION_ARGS_PORTS]] \
+ rpm [list action_target [ACTION_ARGS_PORTS]] \
+ srpm [list action_target [ACTION_ARGS_PORTS]] \
+ \
+ quit [list action_exit [ACTION_ARGS_NONE]] \
+ exit [list action_exit [ACTION_ARGS_NONE]] \
+]
+
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+ global action_array
+
+ if { ! [info exists action_array($action)] } {
+ set guess [guess_action $action]
+ if { [info exists action_array($guess)] } {
+ return $guess
+ }
+ return $guess
+ }
+
+ return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
+proc find_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ } else {
+ set action [complete_action $action]
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+ }
+
+ return $action_proc
+}
+
+proc get_action_proc { action } {
+ global action_array
+
+ set action_proc ""
+ if { [info exists action_array($action)] } {
+ set action_proc [lindex $action_array($action) 0]
+ }
+
+ return $action_proc
+}
+
+# Returns whether an action expects text arguments at all,
+# expects text arguments or wants an expanded list of ports
+# Return values are constants:
+# [ACTION_ARGS_NONE] Does not expect any text argument
+# [ACTION_ARGS_STRINGS] Expects some strings as text argument
+# [ACTION_ARGS_PORTS] Wants an expanded list of ports as text argument
+proc action_needs_portlist { action } {
+ global action_array
+
+ set ret 0
+ if {[info exists action_array($action)]} {
+ set ret [lindex $action_array($action) 1]
+ }
+
+ return $ret
+}
+
+# cmd_opts_array specifies which arguments the commands accept
+# Commands not listed here do not accept any arguments
+# Syntax if {option argn}
+# Where option is the name of the option and argn specifies how many arguments
+# this argument takes
+global cmd_opts_array
+array set cmd_opts_array {
+ edit {{editor 1}}
+ info {category categories depends_fetch depends_extract
+ depends_build depends_lib depends_run
+ depends description epoch fullname heading homepage index license
+ line long_description
+ maintainer maintainers name platform platforms portdir pretty
+ replaced_by revision subports variant variants version}
+ contents {size {units 1}}
+ deps {index no-build}
+ rdeps {index no-build full}
+ rdependents {full}
+ search {case-sensitive category categories depends_fetch
+ depends_extract depends_build depends_lib depends_run
+ depends description epoch exact glob homepage line
+ long_description maintainer maintainers name platform
+ platforms portdir regex revision variant variants version}
+ selfupdate {nosync}
+ space {{units 1} total}
+ activate {no-exec}
+ deactivate {no-exec}
+ install {no-rev-upgrade unrequested}
+ uninstall {follow-dependents follow-dependencies no-exec}
+ variants {index}
+ clean {all archive dist work logs}
+ mirror {new}
+ lint {nitpick}
+ select {list set show summary}
+ log {{phase 1} {level 1}}
+ upgrade {force enforce-variants no-replace no-rev-upgrade}
+ rev-upgrade {id-loadcmd-check}
+ doctor {quiet}
+}
+
+##
+# Checks whether the given option is valid
+#
+# @param action for which action
+# @param option the prefix of the option to check
+# @return list of pairs {name argc} for all matching options
+proc cmd_option_matches {action option} {
+ global cmd_opts_array
+
+ # This could be so easy with lsearch -index,
+ # but that's only available as of Tcl 8.5
+
+ if {![info exists cmd_opts_array($action)]} {
+ return {}
+ }
+
+ set result {}
+
+ foreach item $cmd_opts_array($action) {
+ if {[llength $item] == 1} {
+ set name $item
+ set argc 0
+ } else {
+ set name [lindex $item 0]
+ set argc [lindex $item 1]
+ }
+
+ if {$name == $option} {
+ set result [list [list $name $argc]]
+ break
+ } elseif {[string first $option $name] == 0} {
+ lappend result [list $name $argc]
+ }
+ }
+
+ return $result
+}
+
+# Parse global options
+#
+# Note that this is called several times:
+# (1) Initially, to parse options that will be constant across all commands
+# (options that come prior to any command, frozen into global_options_base)
+# (2) Following each command (to parse options that will be unique to that command
+# (the global_options array is reset to global_options_base prior to each command)
+#
+proc parse_options { action ui_options_name global_options_name } {
+ upvar $ui_options_name ui_options
+ upvar $global_options_name global_options
+ global cmdname cmd_opts_array
+
+ while {[moreargs]} {
+ set arg [lookahead]
+
+ if {[string index $arg 0] ne "-"} {
+ break
+ } elseif {[string index $arg 1] eq "-"} {
+ # Process long arguments
+ switch -- $arg {
+ -- { # This is the options terminator; do no further option processing
+ advance; break
+ }
+ default {
+ set key [string range $arg 2 end]
+ set kopts [cmd_option_matches $action $key]
+ if {[llength $kopts] == 0} {
+ return -code error "${action} does not accept --${key}"
+ } elseif {[llength $kopts] > 1} {
+ set errlst {}
+ foreach e $kopts {
+ lappend errlst "--[lindex $e 0]"
+ }
+ return -code error "\"port ${action} --${key}\" is ambiguous: \n port ${action} [join $errlst "\n port ${action} "]"
+ }
+ set key [lindex $kopts 0 0]
+ set kargc [lindex $kopts 0 1]
+ if {$kargc == 0} {
+ set global_options(ports_${action}_${key}) yes
+ } else {
+ set args {}
+ while {[moreargs] && $kargc > 0} {
+ advance
+ lappend args [lookahead]
+ set kargc [expr {$kargc - 1}]
+ }
+ if {$kargc > 0} {
+ return -code error "--${key} expects [expr {$kargc + [llength $args]}] parameters!"
+ }
+ set global_options(ports_${action}_${key}) $args
+ }
+ }
+ }
+ } else {
+ # Process short arg(s)
+ set opts [string range $arg 1 end]
+ foreach c [split $opts {}] {
+ switch -- $c {
+ v {
+ set ui_options(ports_verbose) yes
+ }
+ d {
+ set ui_options(ports_debug) yes
+ # debug implies verbose
+ set ui_options(ports_verbose) yes
+ }
+ q {
+ set ui_options(ports_quiet) yes
+ }
+ p {
+ # Ignore errors while processing within a command
+ set ui_options(ports_processall) yes
+ }
+ f {
+ set global_options(ports_force) yes
+ }
+ o {
+ set global_options(ports_ignore_different) yes
+ }
+ n {
+ set global_options(ports_nodeps) yes
+ }
+ u {
+ set global_options(port_uninstall_old) yes
+ }
+ R {
+ set global_options(ports_do_dependents) yes
+ }
+ s {
+ set global_options(ports_source_only) yes
+ }
+ b {
+ set global_options(ports_binary_only) yes
+ }
+ c {
+ set global_options(ports_autoclean) yes
+ }
+ k {
+ set global_options(ports_autoclean) no
+ }
+ t {
+ set global_options(ports_trace) yes
+ }
+ y {
+ set global_options(ports_dryrun) yes
+ }
+ F {
+ # Name a command file to process
+ advance
+ if {[moreargs]} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ }
+ }
+ D {
+ advance
+ if {[moreargs]} {
+ cd [lookahead]
+ }
+ break
+ }
+ default {
+ print_usage; exit 1
+ }
+ }
+ }
+ }
+
+ advance
+ }
+}
+
+# acquire exclusive registry lock for actions that need it
+# returns 1 if locked, 0 otherwise
+proc lock_reg_if_needed {action} {
+ switch -- $action {
+ activate -
+ deactivate -
+ setrequested -
+ unsetrequested -
+ upgrade -
+ uninstall -
+ install {
+ registry::exclusive_lock
+ return 1
+ }
+ }
+ return 0
+}
+
+proc process_cmd { argv } {
+ global cmd_argc cmd_argv cmd_argn \
+ global_options global_options_base private_options ui_options \
+ current_portdir
+ set cmd_argv $argv
+ set cmd_argc [llength $argv]
+ set cmd_argn 0
+
+ set action_status 0
+
+ # Process an action if there is one
+ while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
+ set action [lookahead]
+ advance
+
+ # Handle command separator
+ if { $action == ";" } {
+ continue
+ }
+
+ # Handle a comment
+ if { [string index $action 0] == "#" } {
+ while { [moreargs] } { advance }
+ break
+ }
+
+ set locked [lock_reg_if_needed $action]
+ # Always start out processing an action in current_portdir
+ cd $current_portdir
+
+ # Reset global_options from base before each action, as we munge it just below...
+ array unset global_options
+ array set global_options $global_options_base
+
+ # Find an action to execute
+ set actions [find_action $action]
+ if {[llength $actions] == 1} {
+ set action [lindex $actions 0]
+ set action_proc [get_action_proc $action]
+ } else {
+ if {[llength $actions] > 1} {
+ ui_error "\"port ${action}\" is ambiguous: \n port [join $actions "\n port "]"
+ } else {
+ ui_error "Unrecognized action \"port $action\""
+ }
+ set action_status 1
+ break
+ }
+
+ # Parse options that will be unique to this action
+ # (to avoid abiguity with -variants and a default port, either -- must be
+ # used to terminate option processing, or the pseudo-port current must be specified).
+ if {[catch {parse_options $action ui_options global_options} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error $result
+ set action_status 1
+ break
+ }
+
+ # What kind of arguments does the command expect?
+ set expand [action_needs_portlist $action]
+
+ # Parse action arguments, setting a special flag if there were none
+ # We otherwise can't tell the difference between arguments that evaluate
+ # to the empty set, and the empty set itself.
+ set portlist {}
+ switch -- [lookahead] {
+ ; -
+ _EOF_ {
+ set private_options(ports_no_args) yes
+ }
+ default {
+ if {[ACTION_ARGS_NONE] == $expand} {
+ ui_error "$action does not accept string arguments"
+ set action_status 1
+ break
+ } elseif {[ACTION_ARGS_STRINGS] == $expand} {
+ while { [moreargs] && ![match ";"] } {
+ lappend portlist [lookahead]
+ advance
+ }
+ } elseif {[ACTION_ARGS_PORTS] == $expand} {
+ # Parse port specifications into portlist
+ if {![portExpr portlist]} {
+ ui_error "Improper expression syntax while processing parameters"
+ set action_status 1
+ break
+ }
+ }
+ }
+ }
+
+ # execute the action
+ set action_status [$action_proc $action $portlist [array get global_options]]
+
+ # unlock if needed
+ if {$locked} {
+ registry::exclusive_unlock
+ }
+
+ # Print notifications of just-activated ports.
+ portclient::notifications::display
+
+ # semaphore to exit
+ if {$action_status == -999} break
+ }
+
+ return $action_status
+}
+
+
+proc complete_portname { text state } {
+ global complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices {}
+
+ # Build a list of ports with text as their prefix
+ if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ fatal "search for portname $pattern failed: $result"
+ }
+ foreach {name info} $res {
+ lappend complete_choices $name
+ }
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+
+# return text action beginning with $text
+proc complete_action { text state } {
+ global action_array complete_choices complete_position
+
+ if {$state == 0} {
+ set complete_position 0
+ set complete_choices [array names action_array "[string tolower $text]*"]
+ }
+
+ set word [lindex $complete_choices $complete_position]
+ incr complete_position
+
+ return $word
+}
+
+# return all actions beginning with $text
+proc guess_action { text } {
+ global action_array
+
+ return [array names action_array "[string tolower $text]*"]
+
+ if { [llength $complete_choices ] == 1 } {
+ return [lindex $complete_choices 0]
+ }
+
+ return {}
+}
+
+proc attempt_completion { text word start end } {
+ # If the word starts with '~', or contains '.' or '/', then use the build-in
+ # completion to complete the word
+ if { [regexp {^~|[/.]} $word] } {
+ return ""
+ }
+
+ # Decide how to do completion based on where we are in the string
+ set prefix [string range $text 0 [expr {$start - 1}]]
+
+ # If only whitespace characters preceed us, or if the
+ # previous non-whitespace character was a ;, then we're
+ # an action (the first word of a command)
+ if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
+ return complete_action
+ }
+
+ # Otherwise, do completion on portname
+ return complete_portname
+}
+
+
+proc get_next_cmdline { in out use_readline prompt linename } {
+ upvar $linename line
+
+ set line ""
+ while { $line eq "" } {
+
+ if {$use_readline} {
+ set len [readline read -attempted_completion attempt_completion line $prompt]
+ } else {
+ puts -nonewline $out $prompt
+ flush $out
+ set len [gets $in line]
+ }
+
+ if { $len < 0 } {
+ return -1
+ }
+
+ set line [string trim $line]
+
+ if { $use_readline && $line ne "" } {
+ rl_history add $line
+ }
+ }
+
+ return [llength $line]
+}
+
+
+proc process_command_file { in } {
+ global current_portdir
+
+ # Initialize readline
+ set isstdin [string match $in "stdin"]
+ set name "port"
+ set use_readline [expr {$isstdin && [readline init $name]}]
+ set history_file [file normalize "${macports::macports_user_dir}/history"]
+
+ # Read readline history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history read $history_file
+ rl_history stifle 100
+ }
+
+ # Be noisy, if appropriate
+ set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
+ if { $noisy } {
+ puts "MacPorts [macports::version]"
+ puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
+ }
+
+ # Main command loop
+ set exit_status 0
+ while { $exit_status == 0 || $isstdin || [macports::ui_isset ports_processall] } {
+
+ # Calculate our prompt
+ if { $noisy } {
+ set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
+ set prompt "\[$shortdir\] > "
+ } else {
+ set prompt ""
+ }
+
+ # Get a command line
+ if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
+ puts ""
+ break
+ }
+
+ # Process the command
+ set exit_status [process_cmd $line]
+
+ # Check for semaphore to exit
+ if {$exit_status == -999} {
+ set exit_status 0
+ break
+ }
+ }
+
+ # Create macports user directory if it does not exist yet
+ if {$use_readline && ![file isdirectory $macports::macports_user_dir]} {
+ file mkdir $macports::macports_user_dir
+ }
+ # Save readine history
+ if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
+ rl_history write $history_file
+ }
+
+ # Say goodbye
+ if { $noisy } {
+ puts "Goodbye"
+ }
+
+ return $exit_status
+}
+
+
+proc process_command_files { filelist } {
+ set exit_status 0
+
+ # For each file in the command list, process commands
+ # in the file
+ foreach file $filelist {
+ if {$file eq "-"} {
+ set in stdin
+ } else {
+ if {[catch {set in [open $file]} result]} {
+ fatal "Failed to open command file; $result"
+ }
+ }
+
+ set exit_status [process_command_file $in]
+
+ if {$in ne "stdin"} {
+ close $in
+ }
+
+ # Exit on first failure unless -p was given
+ if {$exit_status != 0 && ![macports::ui_isset ports_processall]} {
+ return $exit_status
+ }
+ }
+
+ return $exit_status
+}
+
+namespace eval portclient::progress {
+ ##
+ # Maximum width of the progress bar or indicator when displaying it.
+ variable maxWidth 50
+
+ ##
+ # The start time of the last progress callback as returned by [clock time].
+ # Since only one progress indicator is active at a time, this variable is
+ # shared between the different variants of progress functions.
+ variable startTime
+
+ ##
+ # Delay in milliseconds after the start of the operation before deciding
+ # that showing a progress bar makes sense.
+ variable showTimeThreshold 500
+
+ ##
+ # Percentage value between 0 and 1 that must not have been reached yet when
+ # $showTimeThreshold has passed for a progress bar to be shown. If the
+ # operation has proceeded above e.g. 75% after 500ms we won't bother
+ # displaying a progress indicator anymore -- the operation will be finished
+ # in well below a second anyway.
+ variable showPercentageThreshold 0.75
+
+ ##
+ # Boolean indication whether the progress indicator should be shown or is
+ # still hidden because the current operation didn't need enough time for
+ # a progress indicator to make sense, yet.
+ variable show no
+
+ ##
+ # Initialize the progress bar display delay; call this from the start
+ # action of the progress functions.
+ proc initDelay {} {
+ variable show
+ variable startTime
+
+ set startTime [clock milliseconds]
+ set show no
+ }
+
+ ##
+ # Determine whether a progress bar should be shown for the current
+ # operation in its current state. You must have called initDelay for the
+ # current operation before calling this method.
+ #
+ # @param cur
+ # Current progress in abstract units.
+ # @param total
+ # Total number of abstract units to be processed, if known. Pass
+ # 0 if unknown.
+ # @return
+ # "yes", if the progress indicator should be shown, "no" otherwise.
+ proc showProgress {cur total} {
+ variable show
+ variable startTime
+ variable showTimeThreshold
+ variable showPercentageThreshold
+
+ if {$show eq "yes"} {
+ return yes
+ } else {
+ if {[expr {[clock milliseconds] - $startTime}] > $showTimeThreshold &&
+ ($total == 0 || [expr {double($cur) / double($total)}] < $showPercentageThreshold)} {
+ set show yes
+ }
+ return $show
+ }
+ }
+
+ ##
+ # Progress callback for generic operations executed by macports 1.0.
+ #
+ # @param action
+ # One of "start", "update", "intermission" or "finish", where start
+ # will be called before any number of update calls, interrupted by
+ # any number of intermission calls (called because other output is
+ # being produced), followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # "intermission" and "finish", the args are empty and unused. For
+ # "update", args contains $cur and $total, where $cur is the current
+ # number of units processed and $total is the total number of units
+ # to be processed. If the total is not known, it is 0.
+ proc generic {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {now total} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ progressbar $now $total [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ } else {
+ unprogressbar [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen)}] $barPrefix
+ }
+ }
+ }
+ }
+ intermission -
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Progress callback for downloads executed by macports 1.0.
+ #
+ # This is essentially a cURL progress callback.
+ #
+ # @param action
+ # One of "start", "update" or "finish", where start will be called
+ # before any number of update calls, followed by one call to finish.
+ # @param args
+ # A list of variadic args that differ for each action. For "start",
+ # contains a single argument "ul" or "dl" indicating whether this is
+ # an up- or download. For "update", contains the arguments
+ # ("ul"|"dl") $total $now $speed where ul/dl are as for start, and
+ # total, now and speed are doubles indicating the total transfer
+ # size, currently transferred amount and average speed per second in
+ # bytes. Unused for "finish".
+ proc download {action args} {
+ global env
+ variable maxWidth
+
+ switch -nocase -- $action {
+ start {
+ initDelay
+ }
+ update {
+ # the for loop is a simple hack because Tcl 8.4 doesn't have
+ # lassign
+ foreach {type total now speed} $args {
+ if {[showProgress $now $total] eq "yes"} {
+ set barPrefix " "
+ set barPrefixLen [string length $barPrefix]
+ if {$total != 0} {
+ set barSuffix [format " speed: %-13s" "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ progressbar $now $total $barLen $barPrefix $barSuffix
+ } else {
+ set barSuffix [format " %-10s speed: %-13s" [bytesize $now {} "%6.1f"] "[bytesize $speed {} "%.1f"]/s"]
+ set barSuffixLen [string length $barSuffix]
+
+ set barLen [expr {min($maxWidth, $env(COLUMNS) - $barPrefixLen - $barSuffixLen)}]
+ unprogressbar $barLen $barPrefix $barSuffix
+ }
+ }
+ }
+ }
+ finish {
+ # erase to start of line
+ ::term::ansi::send::esol
+ # return cursor to start of line
+ puts -nonewline "\r"
+ flush stdout
+ }
+ }
+
+ return 0
+ }
+
+ ##
+ # Draw a progress bar using unicode block drawing characters
+ #
+ # @param current
+ # The current progress value.
+ # @param total
+ # The progress value representing 100%.
+ # @param width
+ # The width in characters of the progress bar. This includes percentage
+ # output, which takes up 8 characters.
+ # @param prefix
+ # Prefix to be printed in front of the progress bar.
+ # @param suffix
+ # Suffix to be printed after the progress bar.
+ proc progressbar {current total width {prefix ""} {suffix ""}} {
+ # Subtract the width of the percentage output, also subtract the two
+ # characters [ and ] bounding the progress bar.
+ set percentageWidth 8
+ set barWidth [expr {entier($width) - $percentageWidth - 2}]
+
+ # Map the range (0, $total) to (0, 4 * $width) where $width is the maximum
+ # numebr of characters to be printed for the progress bar. Multiply the
+ # upper bound with 8 because we have 8 sub-states per character.
+ set barProgress [expr {entier(round(($current * $barWidth * 8) / $total))}]
+
+ set barInteger [expr {$barProgress / 8}]
+ #set barRemainder [expr {$barProgress % 8}]
+
+ # Finally, also provide a percentage value to print behind the progress bar
+ set percentage [expr {double($current) * 100 / double($total)}]
+
+ # clear the current line, enable reverse video
+ set progressbar "\033\[7m"
+ for {set i 0} {$i < $barInteger} {incr i} {
+ # U+2588 FULL BLOCK doesn't match the other blocks in some fonts :/
+ # Two half blocks work better in some fonts, but not in others (because
+ # they leave ugly spaces). So, one or the other choice isn't better or
+ # worse and even just using full blocks looks ugly in a few fonts.
+
+ # Use pure ASCII until somebody fixes most of the default terminal fonts :/
+ append progressbar " "
+ }
+ # back to normal output
+ append progressbar "\033\[0m"
+
+ #switch $barRemainder {
+ # 0 {
+ # if {$barInteger < $barWidth} {
+ # append progressbar " "
+ # }
+ # }
+ # 1 {
+ # # U+258F LEFT ONE EIGHTH BLOCK
+ # append progressbar "\u258f"
+ # }
+ # 2 {
+ # # U+258E LEFT ONE QUARTER BLOCK
+ # append progressbar "\u258e"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 3 {
+ # # U+258D LEFT THREE EIGHTHS BLOCK
+ # append progressbar "\u258d"
+ # }
+ # 4 {
+ # # U+258C LEFT HALF BLOCK
+ # append progressbar "\u258c"
+ # }
+ # 5 {
+ # # U+258B LEFT FIVE EIGHTHS BLOCK
+ # append progressbar "\u258b"
+ # }
+ # 6 {
+ # # U+258A LEFT THREE QUARTERS BLOCK
+ # append progressbar "\u258a"
+ # }
+ # 7 {
+ # # U+2589 LEFT SEVEN EIGHTHS BLOCK
+ # append progressbar "\u2589"
+ # }
+ #}
+
+ # Fill the progress bar with spaces
+ for {set i $barInteger} {$i < $barWidth} {incr i} {
+ append progressbar " "
+ }
+
+ # Format the percentage using the space that has been reserved for it
+ set percentagesuffix [format " %[expr {$percentageWidth - 3}].1f %%" $percentage]
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${percentagesuffix}${suffix}"
+ flush stdout
+ }
+
+
+ ##
+ # Internal state of the progress indicator; unless you're hacking the
+ # unprogressbar code you should never touch this.
+ variable unprogressState 0
+
+ ##
+ # Draw a progress indicator
+ #
+ # @param width
+ # The width in characters of the progress indicator.
+ # @param prefix
+ # Prefix to be printed in front of the progress indicator.
+ # @param suffix
+ # Suffix to be printed after the progress indicator.
+ proc unprogressbar {width {prefix ""} {suffix ""}} {
+ variable unprogressState
+
+ # Subtract the two characters [ and ] bounding the progress indicator
+ # from the width.
+ set barWidth [expr {int($width) - 2}]
+
+ # Number of states of the progress bar, or rather: the number of
+ # characters before the sequence repeats.
+ set numStates 4
+
+ set unprogressState [expr {($unprogressState + 1) % $numStates}]
+
+ set progressbar ""
+ for {set i 0} {$i < $barWidth} {incr i} {
+ if {[expr {$i % $numStates}] == $unprogressState} {
+ # U+2022 BULLET
+ append progressbar "\u2022"
+ } else {
+ append progressbar " "
+ }
+ }
+
+ puts -nonewline "\r${prefix}\[${progressbar}\]${suffix}"
+ flush stdout
+ }
+}
+
+namespace eval portclient::notifications {
+ ##
+ # Ports whose notifications to display; these were either installed
+ # or requested to be installed.
+ variable notificationsToPrint
+ array set notificationsToPrint {}
+
+ ##
+ # Add a port to the list for printing notifications.
+ #
+ # @param name
+ # The name of the port.
+ # @param note
+ # A list of notes to be stored for the given port.
+ proc append {name notes} {
+ variable notificationsToPrint
+
+ set notificationsToPrint($name) $notes
+ }
+
+ ##
+ # Print port notifications.
+ #
+ proc display {} {
+ global env
+ variable notificationsToPrint
+
+ # Display notes at the end of the activation phase.
+ if {[array size notificationsToPrint] > 0} {
+ ui_notice "---> Some of the ports you installed have notes:"
+ foreach {name notes} [array get notificationsToPrint] {
+ ui_notice " $name has the following notes:"
+
+ # If env(COLUMNS) exists, limit each line's width to this width.
+ if {[info exists env(COLUMNS)]} {
+ set maxlen $env(COLUMNS)
+
+ foreach note $notes {
+ foreach line [split $note "\n"] {
+ set joiner ""
+ set lines ""
+ set newline " "
+
+ foreach word [split $line " "] {
+ if {[string length $newline] + [string length $word] >= $maxlen} {
+ lappend lines $newline
+ set newline " "
+ set joiner ""
+ }
+ ::append newline $joiner $word
+ set joiner " "
+ }
+ if {$newline ne {}} {
+ lappend lines $newline
+ }
+ ui_notice [join $lines "\n"]
+ }
+ }
+ } else {
+ foreach note $notes {
+ ui_notice $note
+ }
+ }
+ }
+ }
+ }
+}
+
+
+##########################################
+# Main
+##########################################
+
+# Global arrays passed to the macports1.0 layer
+array set ui_options {}
+array set global_options {}
+array set global_variations {}
+
+# Global options private to this script
+array set private_options {}
+
+# Make sure we get the size of the terminal
+# We do this here to save it in the boot_env, in case we determined it manually
+term_init_size
+
+global env boot_env argv0 cmdname argc argv cmd_argc cmd_argv cmd_argn \
+ current_portdir global_options_base exit_status
+
+# Save off a copy of the environment before mportinit monkeys with it
+array set boot_env [array get env]
+
+set cmdname [file tail $argv0]
+
+# Setp cmd_argv to match argv
+set cmd_argv $argv
+set cmd_argc $argc
+set cmd_argn 0
+
+# make sure we're using a sane umask
+umask 022
+
+# If we've been invoked as portf, then the first argument is assumed
+# to be the name of a command file (i.e., there is an implicit -F
+# before any arguments).
+if {[moreargs] && $cmdname eq "portf"} {
+ lappend ui_options(ports_commandfiles) [lookahead]
+ advance
+}
+
+# Parse global options that will affect all subsequent commands
+if {[catch {parse_options "global" ui_options global_options} result]} {
+ puts "Error: $result"
+ print_usage
+ exit 1
+}
+
+if {[isatty stdout]
+ && $portclient::progress::hasTermAnsiSend eq "yes"
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")} {
+ set ui_options(progress_download) portclient::progress::download
+ set ui_options(progress_generic) portclient::progress::generic
+}
+
+set ui_options(notifications_append) portclient::notifications::append
+
+# Get arguments remaining after option processing
+set remaining_args [lrange $cmd_argv $cmd_argn end]
+
+# If we have no arguments remaining after option processing then force
+# interactive mode
+if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
+ lappend ui_options(ports_commandfiles) -
+} elseif {[lookahead] eq "selfupdate" || [lookahead] eq "sync"} {
+ # tell mportinit not to tell the user they should selfupdate
+ set ui_options(ports_no_old_index_warning) 1
+}
+
+# Initialize mport
+# This must be done following parse of global options, as some options are
+# evaluated by mportinit.
+if {[catch {mportinit ui_options global_options global_variations} result]} {
+ global errorInfo
+ puts "$errorInfo"
+ fatal "Failed to initialize MacPorts, $result"
+}
+
+# Set up some global state for our code
+set current_portdir [pwd]
+
+# Freeze global_options into global_options_base; global_options
+# will be reset to global_options_base prior to processing each command.
+set global_options_base [array get global_options]
+
+# First process any remaining args as action(s)
+set exit_status 0
+if { [llength $remaining_args] > 0 } {
+
+ # If there are remaining arguments, process those as a command
+ set exit_status [process_cmd $remaining_args]
+}
+
+# Process any prescribed command files, including standard input
+if { ($exit_status == 0 || [macports::ui_isset ports_processall]) && [info exists ui_options(ports_commandfiles)] } {
+ set exit_status [process_command_files $ui_options(ports_commandfiles)]
+}
+if {$exit_status == -999} {
+ set exit_status 0
+}
+
+# shut down macports1.0
+mportshutdown
+
+# Return with exit_status
+exit $exit_status
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20140813/4691a054/attachment-0001.html>
More information about the macports-changes
mailing list