<pre style='margin:0'>
Joshua Root (jmroot) pushed a commit to branch master
in repository macports-base.

</pre>
<p><a href="https://github.com/macports/macports-base/commit/9fcad0a776953cf4975273e3bb94003867a33071">https://github.com/macports/macports-base/commit/9fcad0a776953cf4975273e3bb94003867a33071</a></p>
<pre style="white-space: pre; background: #F8F8F8"><span style='display:block; white-space:pre;color:#808000;'>commit 9fcad0a776953cf4975273e3bb94003867a33071
</span>Author: Joshua Root <jmr@macports.org>
AuthorDate: Fri Mar 8 01:48:36 2024 +1100

<span style='display:block; white-space:pre;color:#404040;'>    portindex, portmirror: global cleanup
</span>---
 src/port/portindex.tcl  | 132 ++++++++++++++++++++++++++----------------------
 src/port/portmirror.tcl |  10 ++--
 2 files changed, 78 insertions(+), 64 deletions(-)

<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/portindex.tcl b/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 156caa098..5b2471040 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -34,8 +34,9 @@ proc print_usage args {
</span> }
 
 proc _write_index {name len line} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    puts $::fd [list $name $len]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    puts $::fd $line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global fd
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    puts $fd [list $name $len]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    puts $fd $line
</span> }
 
 # Code that runs in worker threads
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -45,14 +46,15 @@ package require macports
</span> package require Thread
 
 proc _read_index {idx} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set offset [dict get $::qindex $idx]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global qindex oldfd
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set offset [dict get $qindex $idx]
</span>     thread::mutex lock [tsv::get mutexes PortIndex]
     try {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        seek $::oldfd $offset
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        gets $::oldfd in_line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        seek $oldfd $offset
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        gets $oldfd in_line
</span> 
         set len [lindex $in_line 1]
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        set out_line [read $::oldfd [expr {$len - 1}]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set out_line [read $oldfd [expr {$len - 1}]]
</span>     } finally {
         thread::mutex unlock [tsv::get mutexes PortIndex]
     }
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -62,9 +64,9 @@ proc _read_index {idx} {
</span> }
 
 proc _index_from_portinfo {portinfo {is_subport no}} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global keepkeys
</span>     set keep_portinfo [dict filter $portinfo script {key val} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        dict exists $::keepkeys $key
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        dict exists $keepkeys $key
</span>     }]
 
     # if this is not a subport, add the "subports" key
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -77,19 +79,19 @@ proc _index_from_portinfo {portinfo {is_subport no}} {
</span> }
 
 proc _open_port {portdir absportdir port_options {subport {}}} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global macports::prefix save_prefix
</span>     # Make sure $prefix expands to '${prefix}' so that the PortIndex is
     # portable across prefixes, see https://trac.macports.org/ticket/53169 and
     # https://trac.macports.org/ticket/17182.
     macports_try -pass_signal {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        set macports::prefix {${prefix}}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set prefix {${prefix}}
</span>         if {$subport ne {}} {
             dict set port_options subport $subport
         }
         set mport [mportopen file://$absportdir $port_options]
     } finally {
         # Restore prefix to the previous value
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        set macports::prefix $::save_prefix
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set prefix $save_prefix
</span>     }
 
     set portinfo [mportinfo $mport]
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -100,9 +102,10 @@ proc _open_port {portdir absportdir port_options {subport {}}} {
</span> }
 
 proc pindex {portdir jobnum {subport {}}} {
<span style='display:block; white-space:pre;background:#e0ffe0;'>+    global directory full_reindex qindex oldmtime ui_options port_options
</span>     try {
         tsv::set status $jobnum 1
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        set absportdir [file join $::directory $portdir]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        set absportdir [file join $directory $portdir]
</span>         set portfile [file join $absportdir Portfile]
         if {$subport ne ""} {
             set qname [string tolower $subport]
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -112,10 +115,10 @@ proc pindex {portdir jobnum {subport {}}} {
</span>             set is_subport 0
         }
         # try to reuse the existing entry if it's still valid
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        if {$::full_reindex != 1 && [dict exists $::qindex $qname]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        if {$full_reindex != 1 && [dict exists $qindex $qname]} {
</span>             macports_try -pass_signal {
                 set mtime [file mtime $portfile]
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                if {$::oldmtime >= $mtime} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                if {$oldmtime >= $mtime} {
</span>                     lassign [_read_index $qname] name len portinfo
 
                     # reuse entry if it was made from the same portdir
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -123,7 +126,7 @@ proc pindex {portdir jobnum {subport {}}} {
</span>                         tsv::set output $jobnum [list $name $len $portinfo]
 
                         if {!$is_subport} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                            if {[info exists ::ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                            if {[info exists ui_options(ports_debug)]} {
</span>                                 puts "Reusing existing entry for $portdir"
                             }
 
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -139,14 +142,14 @@ proc pindex {portdir jobnum {subport {}}} {
</span>                 }
             } on error {} {
                 ui_warn "Failed to open old entry for ${portdir}, making a new one"
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                if {[info exists ::ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                if {[info exists ui_options(ports_debug)]} {
</span>                     puts "$::errorInfo"
                 }
             }
         }
 
         macports_try -pass_signal {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-            set portinfo [_open_port $portdir $absportdir $::port_options $subport]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            set portinfo [_open_port $portdir $absportdir $port_options $subport]
</span>             if {$is_subport} {
                 puts "Adding subport $subport"
             } else {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -184,68 +187,77 @@ proc pindex {portdir jobnum {subport {}}} {
</span> # End worker_init_script
 
 proc init_threads {} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    append ::worker_init_script \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set qindex $::qindex] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set keepkeys $::keepkeys] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list array set ui_options [array get ::ui_options]] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list array set global_options [array get ::global_options]] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set port_options $::port_options] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set save_prefix $::save_prefix] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set directory $::directory] \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        [list set full_reindex $::full_reindex] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global worker_init_script qindex keepkeys ui_options \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+           global_options port_options save_prefix directory \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+           full_reindex oldfd oldmtime maxjobs poolid pending_jobs \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+           nextjobnum
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    append worker_init_script \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set qindex $qindex] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set keepkeys $keepkeys] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list array set ui_options [array get ui_options]] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list array set global_options [array get global_options]] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set port_options $port_options] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set save_prefix $save_prefix] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set directory $directory] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        [list set full_reindex $full_reindex] \n \
</span>         [list mportinit ui_options global_options] \n \
         [list signal default {TERM INT}]
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    if {[info exists ::oldfd]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        append ::worker_init_script \n \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            [list set outpath $::outpath] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    if {[info exists oldfd]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        global outpath
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        append worker_init_script \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            [list set outpath $outpath] \n \
</span>             {set oldfd [open $outpath r]} \n
     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    if {[info exists ::oldmtime]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        append ::worker_init_script \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            [list set oldmtime $::oldmtime] \n
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    if {[info exists oldmtime]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        append worker_init_script \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            [list set oldmtime $oldmtime] \n
</span>     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set ::maxjobs [macports::get_parallel_jobs no]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set ::poolid [tpool::create -minworkers $::maxjobs -maxworkers $::maxjobs -initcmd $::worker_init_script]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set ::pending_jobs [dict create]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set ::nextjobnum 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set maxjobs [macports::get_parallel_jobs no]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set poolid [tpool::create -minworkers $maxjobs -maxworkers $maxjobs -initcmd $worker_init_script]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set pending_jobs [dict create]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set nextjobnum 0
</span>     tsv::set mutexes PortIndex [thread::mutex create]
 }
 
 proc handle_completed_jobs {} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set completed_jobs [tpool::wait $::poolid [dict keys $::pending_jobs]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    global poolid pending_jobs stats
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set completed_jobs [tpool::wait $poolid [dict keys $pending_jobs]]
</span>     foreach completed_job $completed_jobs {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-        lassign [dict get $::pending_jobs $completed_job] jobnum portdir subport
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-        dict unset ::pending_jobs $completed_job
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        lassign [dict get $pending_jobs $completed_job] jobnum portdir subport
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+        dict unset pending_jobs $completed_job
</span>         tsv::get status $jobnum status
         # -1 = skipped, 0 = success, 1 = fail, 99 = exit
         if {$status == 99} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-            set ::exit_fail 1
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            set ::pending_jobs ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            global exit_fail
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            set exit_fail 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            set pending_jobs ""
</span>             return -code break "Interrupt"
         } elseif {$status == 1} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-            dict incr ::stats failed
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-            dict incr ::stats total
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            dict incr stats failed
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+            dict incr stats total
</span>             if {[tsv::exists output $jobnum]} {
                 tsv::unset output $jobnum
             }
         } elseif {$status == 0 || $status == -1} {
<span style='display:block; white-space:pre;background:#e0ffe0;'>+            global nextjobnum
</span>             # queue jobs for subports
             if {$subport eq "" && [tsv::exists subports $jobnum]} {
                 foreach nextsubport [tsv::get subports $jobnum] {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                    tsv::set status $::nextjobnum 99
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                    set jobid [tpool::post -nowait $::poolid [list pindex $portdir $::nextjobnum $nextsubport]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                    dict set ::pending_jobs $jobid [list $::nextjobnum $portdir $nextsubport]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                    incr ::nextjobnum
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                    tsv::set status $nextjobnum 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                    set jobid [tpool::post -nowait $poolid [list pindex $portdir $nextjobnum $nextsubport]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                    dict set pending_jobs $jobid [list $nextjobnum $portdir $nextsubport]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                    incr nextjobnum
</span>                 }
                 tsv::unset subports $jobnum
             }
             if {$status == -1} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                dict incr ::stats skipped
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                dict incr stats skipped
</span>             } else {
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                dict incr ::stats total
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                global newest
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                dict incr stats total
</span>                 tsv::get mtime $jobnum mtime
<span style='display:block; white-space:pre;background:#ffe0e0;'>-                if {$mtime > $::newest} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-                    set ::newest $mtime
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                if {$mtime > $newest} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+                    set newest $mtime
</span>                 }
                 tsv::unset mtime $jobnum
             }
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -260,29 +272,31 @@ proc handle_completed_jobs {} {
</span> 
 # post new job to the pool
 proc pindex_queue {portdir} {
<span style='display:block; white-space:pre;background:#e0ffe0;'>+    global pending_jobs maxjobs nextjobnum poolid exit_fail
</span>     # Wait for a free thread
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    while {[dict size $::pending_jobs] >= $::maxjobs} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    while {[dict size $pending_jobs] >= $maxjobs} {
</span>         handle_completed_jobs
     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    if {$::exit_fail} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    if {$exit_fail} {
</span>         error "Interrupt"
     }
 
     # Now queue the new job.
     # Start with worst status so we get it when the thread
     # returns due to ctrl-c etc.
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    tsv::set status $::nextjobnum 99
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    set jobid [tpool::post -nowait $::poolid [list pindex $portdir $::nextjobnum {}]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    dict set ::pending_jobs $jobid [list $::nextjobnum $portdir {}]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-    incr ::nextjobnum
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    tsv::set status $nextjobnum 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set jobid [tpool::post -nowait $poolid [list pindex $portdir $nextjobnum {}]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    dict set pending_jobs $jobid [list $nextjobnum $portdir {}]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    incr nextjobnum
</span> }
 
 proc process_remaining {} {
<span style='display:block; white-space:pre;background:#e0ffe0;'>+    global pending_jobs poolid
</span>     # let remaining jobs finish
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    while {[dict size $::pending_jobs] > 0} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    while {[dict size $pending_jobs] > 0} {
</span>         handle_completed_jobs
     }
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    tpool::release $::poolid
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    tpool::release $poolid
</span>     thread::mutex destroy [tsv::get mutexes PortIndex]
 }
 
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/portmirror.tcl b/src/port/portmirror.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index b63c9f2a5..04403678b 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/portmirror.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/portmirror.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -41,7 +41,7 @@ proc iterate_distfiles_r {func root} {
</span> #           the path as its parameter)
 proc iterate_distfiles {func} {
     global macports::portdbpath
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    iterate_distfiles_r $func [file join ${macports::portdbpath} distfiles]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    iterate_distfiles_r $func [file join ${portdbpath} distfiles]
</span> }
 
 # Check if the file is in the map and delete it otherwise.
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -54,9 +54,9 @@ proc iterate_walker {path} {
</span> }
 
 # Open the database
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc open_database args {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc open_database {args} {
</span>     global macports::portdbpath distfiles_filemap
<span style='display:block; white-space:pre;background:#ffe0e0;'>-    set path [file join ${macports::portdbpath} distfiles_mirror.db]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+    set path [file join ${portdbpath} distfiles_mirror.db]
</span>     if {[file exists $path]} {
         filemap open distfiles_filemap $path readonly
     } else {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -65,13 +65,13 @@ proc open_database args {
</span> }
 
 # Close the database
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc close_database args {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc close_database {args} {
</span>     global distfiles_filemap
     filemap close distfiles_filemap
 }
 
 # Standard procedures
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc print_usage args {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc print_usage {args} {
</span>     global argv0
     puts "Usage: $argv0"
 }
</pre><pre style='margin:0'>

</pre>