Ticket #20626: patch-procs.diff

File patch-procs.diff, 28.9 KB (added by david.osguthorpe@…, 15 years ago)

  • base/src/registry1.0/portuninstall.tcl

     
    3838
    3939namespace eval portuninstall {
    4040
     41
     42proc run-pre-uninstall {ref portname version revision variants} {
     43        # this is not used in this procedure
     44        # also not used in deactivate - even though defined
     45        # I suspect it was assumed that the file names are being taken
     46        # from the registry so prefix not needed
     47        # we no longer need to worry about it here as we have added the definition
     48        # to makeprepostuserproc
     49        # I think the prefix should be stored in the registry and restored from there
     50        # then dont have to assume the prefix is the same as when the port was first
     51        # installed
     52        #global macports::prefix
     53
     54        # execute the pre-uninstall procedures
     55        set uninstall-proc-list [registry::property_retrieve $ref regproc-pre-uninstall-list]
     56        if { ${uninstall-proc-list} != 0 } {
     57                foreach myuninstall ${uninstall-proc-list} {
     58                        set uninstall-name [lindex $myuninstall 1]
     59                        if {![catch {eval [string map { \\n \n } $myuninstall]} err]} {
     60                                ui_info "Executing ${uninstall-name} procedure"
     61                                if {[catch {${uninstall-name} $portname ${version}_${revision}${variants} $portname ${version} ${revision} ${variants} } err]} {
     62                                        ui_error [format [msgcat::mc "Error executing ${uninstall-name} procedure: %s"] $err]
     63                                }
     64                        } else {
     65                                global errorInfo
     66                                ui_debug "$errorInfo"
     67                                ui_error [format [msgcat::mc "Could not evaluate ${uninstall-name} procedure: %s"] $err]
     68                        }
     69                }
     70        }
     71}
     72
     73proc run-post-uninstall {ref portname version revision variants} {
     74        #global macports::prefix
     75
     76        # execute the post-uninstall procedures
     77        set uninstall-proc-list [registry::property_retrieve $ref regproc-post-uninstall-list]
     78        if { ${uninstall-proc-list} != 0 } {
     79                foreach myuninstall ${uninstall-proc-list} {
     80                        set uninstall-name [lindex $myuninstall 1]
     81                        if {![catch {eval [string map { \\n \n } $myuninstall]} err]} {
     82                                ui_info "Executing ${uninstall-name} procedure"
     83                                if {[catch {${uninstall-name} $portname ${version}_${revision}${variants} $portname ${version} ${revision} ${variants} } err]} {
     84                                        ui_error [format [msgcat::mc "Error executing ${uninstall-name} procedure: %s"] $err]
     85                                }
     86                        } else {
     87                                global errorInfo
     88                                ui_debug "$errorInfo"
     89                                ui_error [format [msgcat::mc "Could not evaluate ${uninstall-name} procedure: %s"] $err]
     90                        }
     91                }
     92        }
     93}
     94
     95
    4196proc uninstall {portname {v ""} optionslist} {
    4297        global uninstall.force uninstall.nochecksum UI_PREFIX
    4398        array set options $optionslist
    … …  
    130185        }
    131186
    132187        set installtype [registry::property_retrieve $ref installtype]
     188
    133189        if { $installtype == "image" && [registry::property_retrieve $ref active] == 1} {
    134190                #return -code error [msgcat::mc "Registry Error: ${portname} ${version}_${revision}${variants} is active."]
    135191                portimage::deactivate $portname ${version}_${revision}${variants} $optionslist
     192        } else {
     193                run-pre-uninstall $ref $portname $version $revision $variants
    136194        }
    137195
    138196        ui_msg "$UI_PREFIX [format [msgcat::mc "Uninstalling %s @%s_%s%s"] $portname $version $revision $variants]"
    139197
    140         # Look to see if the port has registered an uninstall procedure
    141         set uninstall [registry::property_retrieve $ref pkg_uninstall]
    142         if { $uninstall != 0 } {
    143                 if {![catch {eval $uninstall} err]} {
    144                         pkg_uninstall $portname ${version}_${revision}${variants}
    145                 } else {
    146                         global errorInfo
    147                         ui_debug "$errorInfo"
    148                         ui_error [format [msgcat::mc "Could not evaluate pkg_uninstall procedure: %s"] $err]
    149                 }
    150         }
    151 
    152198        # Remove the port from the deps_map if only one version was installed.
    153199        # This is a temporary fix for a deeper problem that is that the dependency
    154200        # map doesn't take the port version into account (but should).
    … …  
    174220                                set sumx {}
    175221                        }
    176222                        set sum1 [lindex $sumx [expr [llength $sumx] - 1]]
    177                         if {![string match $sum1 NONE] && ![info exists uninstall.nochecksum] && ![string equal -nocase $uninstall.nochecksum "yes"] } {
     223                        if {![string match $sum1 NONE] && !([info exists uninstall.nochecksum] && [string equal -nocase $uninstall.nochecksum "yes"]) } {
    178224                                if {![catch {set sum2 [md5 $fname]}]} {
    179225                                        if {![string match $sum1 $sum2]} {
    180226                                                if {![info exists uninstall.force] && ![string equal -nocase $uninstall.force "yes"] } {
    … …  
    211257                        return -code error $result
    212258                }
    213259
     260                # finally run the post-uninstall procedure
     261                # really added for symmetry
     262                # not clear anything useful could be done at this point
     263                # we need to run here because of the return 0 below
     264                # also need to run before delete port from registry - we read the procs
     265                # from the registry!!
     266                # at the moment this is not run if registry has no contents for port
     267                # - note that in that case the registry entry for the port isnt deleted either!!
     268                run-post-uninstall $ref $portname $version $revision $variants
     269
    214270                if {!$uninst_err || [info exists uninstall.force] && [string equal -nocase $uninstall.force "yes"] } {
    215271                        ui_info "$UI_PREFIX [format [msgcat::mc "Uninstall is removing %s from the port registry."] $portname]"
    216272                        registry::delete_entry $ref

  • base/src/registry1.0/portimage.tcl

     
    3232
    3333package provide portimage 1.0
    3434
     35#package require portuninstall 1.0
    3536package require registry 1.0
    3637package require macports 1.0
    3738package require Pextlib 1.0
    … …  
    6263# code very similar to what is used in portinstall is used.
    6364#
    6465
     66# hmm - this looks like can be defined here - not used elsewhere
     67# also means we dont need to require the port1.0 package here
     68
     69namespace eval portinstall {
     70
     71proc run-post-install {ref name version revision variants} {
     72
     73        set install-proc-list [registry::property_retrieve $ref regproc-post-install-list]
     74        if { ${install-proc-list} != 0 } {
     75            foreach install ${install-proc-list} {
     76                set install-name [lindex $install 1]
     77                if {![catch {eval [string map { \\n \n } $install]} err]} {
     78                        ui_info "Executing ${install-name} procedure"
     79                        if {[catch {${install-name} $name ${version}_${revision}${variants} $name ${version} ${revision} ${variants} } err]} {
     80                                ui_error [format [msgcat::mc "Error executing ${install-name} procedure: %s"] $err]
     81                        }
     82                } else {
     83                        global errorInfo
     84                        ui_debug "$errorInfo"
     85                        ui_error [format [msgcat::mc "Could not evaluate ${install-name} procedure: %s"] $err]
     86                }
     87           }
     88        }
     89}
     90
     91}
     92
    6593namespace eval portimage {
    6694
    6795variable force
    … …  
    108136
    109137        set ref [registry::open_entry $name $version $revision $variants]
    110138       
     139        # we need to call things even if not image proc - as a sub-phase of install
     140        # activate for non-image we still call the pre-/post-activate
     141        # - effectively we consider the main activate proc a null proc for non-image installs
     142        set doimage 1
    111143        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
    112                 return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
     144                #return -code error "Image error: ${name} @${version}_${revision}${variants} not installed as an image."
     145                set doimage 0
    113146        }
     147
     148        if {$doimage == 1} {
     149       
    114150        if { [registry::property_retrieve $ref active] != 0 } {
    115151                return -code error "Image error: ${name} @${version}_${revision}${variants} is already active."
    116152        }
    … …  
    118154                return -code error "Image error: ${name} @${version}_${revision}${variants} is compactd."
    119155        }
    120156
     157        }
     158
     159        # execute the pre-activate procedures
     160        set activate-proc-list [registry::property_retrieve $ref regproc-pre-activate-list]
     161        if { ${activate-proc-list} != 0 } {
     162            foreach activate ${activate-proc-list} {
     163                set activate-name [lindex $activate 1]
     164                if {![catch {eval [string map { \\n \n } $activate]} err]} {
     165                        ui_info "Executing ${activate-name} procedure"
     166                        if {[catch {${activate-name} $name ${version}_${revision}${variants} $name ${version} ${revision} ${variants} } err]} {
     167                                ui_error [format [msgcat::mc "Error executing ${activate-name} procedure: %s"] $err]
     168                        }
     169                } else {
     170                        global errorInfo
     171                        ui_debug "$errorInfo"
     172                        ui_error [format [msgcat::mc "Could not evaluate ${activate-name} procedure: %s"] $err]
     173                }
     174           }
     175        }
     176
     177        if {$doimage == 1} {
     178
    121179        set imagedir [registry::property_retrieve $ref imagedir]
    122180
    123181        set contents [registry::property_retrieve $ref contents]
    … …  
    135193                registry::register_file $file $name
    136194        }
    137195        registry::write_file_map
     196
     197        }
     198
     199        # execute the post-activate procedures
     200        set activate-proc-list [registry::property_retrieve $ref regproc-post-activate-list]
     201        if { ${activate-proc-list} != 0 } {
     202            foreach activate ${activate-proc-list} {
     203                set activate-name [lindex $activate 1]
     204                if {![catch {eval [string map { \\n \n } $activate]} err]} {
     205                        ui_info "Executing ${activate-name} procedure"
     206                        if {[catch {${activate-name} $name ${version}_${revision}${variants} $name ${version} ${revision} ${variants} } err]} {
     207                                ui_error [format [msgcat::mc "Error executing ${activate-name} procedure: %s"] $err]
     208                        }
     209                } else {
     210                        global errorInfo
     211                        ui_debug "$errorInfo"
     212                        ui_error [format [msgcat::mc "Could not evaluate ${activate-name} procedure: %s"] $err]
     213                }
     214           }
     215        }
     216
     217        # also execute the post-install procedures
     218        # this solves image/non-image issues
     219        # also going forward makes post-install the primary proc for performing
     220        # actions needed after full installing files eg. starting daemons that depend on
     221        # files being installed
     222        portinstall::run-post-install $ref $name $version $revision $variants
    138223}
    139224
    140225proc deactivate {name v optionslist} {
    … …  
    173258       
    174259        set ref [registry::open_entry $name $version $revision $variants]
    175260
     261        set doimage 1
    176262        if { ![string equal [registry::property_retrieve $ref installtype] "image"] } {
    177                 return -code error "Image error: ${name} @${fqversion} not installed as an image."
     263                #return -code error "Image error: ${name} @${fqversion} not installed as an image."
     264                set doimage 0
    178265        }
     266
     267        if {$doimage == 1} {
     268
    179269        if { [registry::property_retrieve $ref active] != 1 } {
    180270                return -code error "Image error: ${name} @${fqversion} is not active."
    181271        }
    … …  
    183273                return -code error "Image error: ${name} @${fqversion} is compactd."
    184274        }
    185275
     276        }
     277
     278        # execute the pre-uninstall procedures
     279        # we need to do this here as now we consider deactivate a sub-phase of uninstall
     280        # this solves image/non-image issues
     281        # also going forward makes pre-uninstall the primary proc for performing
     282        # actions needed before removing files eg. stopping daemons that depend on
     283        # files that will be removed!!
     284        portuninstall::run-pre-uninstall $ref $name $version $revision $variants
     285
     286        # execute the pre-deactivate procedures
     287        set deactivate-proc-list [registry::property_retrieve $ref regproc-pre-deactivate-list]
     288        if { ${deactivate-proc-list} != 0 } {
     289            foreach deactivate ${deactivate-proc-list} {
     290                set deactivate-name [lindex $deactivate 1]
     291                if {![catch {eval [string map { \\n \n } $deactivate]} err]} {
     292                        ui_info "Executing ${deactivate-name} procedure"
     293                        if {[catch {${deactivate-name} $name ${version}_${revision}${variants} $name ${version} ${revision} ${variants} } err]} {
     294                                ui_error [format [msgcat::mc "Error executing ${deactivate-name} procedure: %s"] $err]
     295                        }
     296                } else {
     297                        global errorInfo
     298                        ui_debug "$errorInfo"
     299                        ui_error [format [msgcat::mc "Could not evaluate ${deactivate-name} procedure: %s"] $err]
     300                }
     301           }
     302        }
     303
     304        if {$doimage == 1} {
     305
    186306        set imagedir [registry::property_retrieve $ref imagedir]
    187307
    188308        set imagefiles [registry::port_registered $name]
    … …  
    199319
    200320        registry::write_entry $ref
    201321
     322        }
     323
     324        # execute the post-deactivate procedures
     325        set deactivate-proc-list [registry::property_retrieve $ref regproc-post-deactivate-list]
     326        if { ${deactivate-proc-list}!= 0 } {
     327            foreach deactivate ${deactivate-proc-list} {
     328                set deactivate-name [lindex $deactivate 1]
     329                if {![catch {eval [string map { \\n \n } $deactivate]} err]} {
     330                        ui_info "Executing ${deactivate-name} procedure"
     331                        if {[catch {${deactivate-name} $name ${version}_${revision}${variants} $name ${version} ${revision} ${variants} } err]} {
     332                                ui_error [format [msgcat::mc "Error executing ${deactivate-name} procedure: %s"] $err]
     333                        }
     334                } else {
     335                        global errorInfo
     336                        ui_debug "$errorInfo"
     337                        ui_error [format [msgcat::mc "Could not evaluate ${deactivate-name} procedure: %s"] $err]
     338                }
     339           }
     340        }
     341
    202342}
    203343
    204344proc compact {name v} {

  • base/src/port1.0/portactivate.tcl

     
    3636package provide portactivate 1.0
    3737package require portutil 1.0
    3838
    39 set org.macports.activate [target_new org.macports.activate activate_main]
    40 target_runtype ${org.macports.activate} always
    41 target_state ${org.macports.activate} no
    42 target_provides ${org.macports.activate} activate
    43 if {[option portarchivemode] == "yes"} {
    44         target_requires ${org.macports.activate} main unarchive fetch extract checksum patch configure build destroot archive install
    45 } else {
    46         target_requires ${org.macports.activate} main fetch extract checksum patch configure build destroot install
    47 }
    48 
    4939set_ui_prefix
    5040
    51 proc activate_main {args} {
    52         global portname portversion portrevision portvariants user_options
    53         registry_activate $portname ${portversion}_${portrevision}${portvariants} [array get user_options]
    54     return 0
    55 }

  • base/src/port1.0/portinstall.tcl

     
    4444}
    4545target_prerun ${org.macports.install} install_start
    4646
     47
     48
     49# unfortunately the procutil version makeuserproc hard encodes no arguments
     50# Im not sure of the utility any more of the info globals - a lot of globals are now in
     51# the ::macports namespace - in particular prefix
     52# name, version, revision are needed to define these original Portfile keywords
     53# portname is duplicate of name but portversion is the filename used in the receipts directory
     54# currently an encoding name, version and revision
     55proc makeprepostproc {name body} {
     56    regsub -- "^\{(.*?)" $body "\{ \n global macports::prefix \n foreach g \[info globals\] \{ \n global \$g \n \} \n \\1" body
     57    eval "proc $name {portname portversion name version revision variants} $body"
     58}
     59
     60# define procedures for understanding activate/deactivate/uninstall pre-/post- sections
     61# in Portfile
     62# code body initially taken from target_provides
     63# the following lists should be initialised for each port
     64# I think this should work as as far as I can tell each port is built through
     65# a separate interpreter hence separate loads of portinstall.tcl
     66namespace eval activate {
     67
     68set proc-pre-activate-list [list]
     69set proc-post-activate-list [list]
     70
     71}
     72
     73proc pre-activate {args} {
     74   global activate::proc-pre-activate-list
     75   variable proc_index
     76   set proc_index [llength ${proc-pre-activate-list}]
     77   set ident "org.macports.activate"
     78   lappend proc-pre-activate-list regproc-pre-${ident}-activate-${proc_index}
     79   makeprepostproc regproc-pre-${ident}-activate-${proc_index} $args
     80}
     81proc post-activate {args} {
     82   global activate::proc-post-activate-list
     83   variable proc_index
     84   set proc_index [llength ${proc-post-activate-list}]
     85   set ident "org.macports.activate"
     86   lappend proc-post-activate-list regproc-post-${ident}-activate-${proc_index}
     87   makeprepostproc regproc-post-${ident}-activate-${proc_index} $args
     88}
     89
     90namespace eval deactivate {
     91
     92set proc-pre-deactivate-list [list]
     93set proc-post-deactivate-list [list]
     94
     95}
     96
     97proc pre-deactivate {args} {
     98   global deactivate::proc-pre-deactivate-list
     99   variable proc_index
     100   set proc_index [llength ${proc-pre-deactivate-list}]
     101   set ident "org.macports.deactivate"
     102   lappend proc-pre-deactivate-list regproc-pre-${ident}-deactivate-${proc_index}
     103   makeprepostproc regproc-pre-${ident}-deactivate-${proc_index} $args
     104}
     105proc post-deactivate {args} {
     106   global deactivate::proc-post-deactivate-list
     107   variable proc_index
     108   set proc_index [llength ${proc-post-deactivate-list}]
     109   set ident "org.macports.deactivate"
     110   lappend proc-post-deactivate-list regproc-post-${ident}-deactivate-${proc_index}
     111   makeprepostproc regproc-post-${ident}-deactivate-${proc_index} $args
     112}
     113
     114# now the same for pre-uninstall
     115# adding a post-uninstall for symmetry but not clear what the point of it would be
     116
     117namespace eval uninstall {
     118set proc-pre-uninstall-list [list]
     119set proc-post-uninstall-list [list]
     120}
     121
     122proc pre-uninstall {args} {
     123   global uninstall::proc-pre-uninstall-list
     124   variable proc_index
     125   set proc_index [llength ${proc-pre-uninstall-list}]
     126   set ident "org.macports.uninstall"
     127   lappend proc-pre-uninstall-list regproc-pre-${ident}-uninstall-${proc_index}
     128   makeprepostproc regproc-pre-${ident}-uninstall-${proc_index} $args
     129}
     130
     131proc post-uninstall {args} {
     132   global uninstall::proc-post-uninstall-list
     133   variable proc_index
     134   set proc_index [llength ${proc-post-uninstall-list}]
     135   set ident "org.macports.uninstall"
     136   lappend proc-post-uninstall-list regproc-post-${ident}-uninstall-${proc_index}
     137   makeprepostproc regproc-post-${ident}-uninstall-${proc_index} $args
     138}
     139
    47140set_ui_prefix
    48141
    49142proc install_start {args} {
    … …  
    128221}
    129222
    130223proc install_main {args} {
    131         global portname portversion portpath categories description long_description homepage depends_run installPlist package-install uninstall workdir worksrcdir pregrefix UI_PREFIX destroot portrevision maintainers ports_force portvariants targets depends_lib PortInfo epoch
     224        global portname portversion portpath categories description long_description homepage depends_run installPlist package-install workdir worksrcdir pregrefix UI_PREFIX destroot portrevision maintainers ports_force portvariants targets depends_lib PortInfo epoch
    132225
     226        global activate::proc-pre-activate-list
     227        global activate::proc-post-activate-list
     228        global deactivate::proc-pre-deactivate-list
     229        global deactivate::proc-post-deactivate-list
     230        global uninstall::proc-pre-uninstall-list
     231        global uninstall::proc-post-uninstall-list
     232
    133233        # Begin the registry entry
    134234        set regref [registry_new $portname $portversion $portrevision $portvariants $epoch]
    135235   
    … …  
    164264                        registry_bulk_register_files [registry_fileinfo_for_index $installPlist] $portname
    165265                }
    166266        }
    167         if {[info exists package-install]} {
    168                 registry_prop_store $regref package-install ${package-install}
     267
     268    if {[info exists package-install]} {
     269        registry_prop_store $regref package-install ${package-install}
    169270    }
    170     if {[info proc pkg_uninstall] == "pkg_uninstall"} {
    171                 registry_prop_store $regref uninstall [proc_disasm pkg_uninstall]
     271
     272    # and yet another issue
     273    # if archivemode is being used and we are restoring an older version
     274    # the pre-/post- procs will be coming from the current Portfile
     275    # we really need to store the pre-/post- procs with the archive
     276    # and restore them here (the Portfile already is but then need to figure out
     277    # how to switch to a different Portfile version)
     278    # this will have to wait for another day
     279    # print warning message at the moment
     280    if {[option portarchivemode] == "yes"} {
     281        ui_info "$UI_PREFIX [format [msgcat::mc "Warning: archivemode is using procs from current Portfile"] ]"
    172282    }
    173        
     283
     284    # save the current post-install section if defined
     285    # - this will now be re-done if a port activate command is run
     286    # note that both userproc-post-org.macports.xxx-xxx-*
     287    # and proc-post-org.macports.xxx-xxx-* are define by target_provides
     288    # unfortunately target_provides will have used makeuserproc which defines
     289    # the procedure with no arguments - we need to have arguments
     290    set temp-proc-list [post_install_munge_proc [info proc userproc-post-org.macports.install-install*]]
     291    if {[llength ${temp-proc-list}] > 0} {
     292        registry_prop_store $regref regproc-post-install-list ${temp-proc-list}
     293    }
     294
     295    # save all the other sections after install pre-/post- procs in the registry
     296    # so are version specific and can be called outside the target execution system
     297    # as activate/deactivate and uninstall are now
     298
     299    set temp-proc-list [munge_proc ${proc-pre-activate-list}]
     300    if {[llength ${temp-proc-list}] > 0} {
     301        registry_prop_store $regref regproc-pre-activate-list ${temp-proc-list}
     302    }
     303
     304    set temp-proc-list [munge_proc ${proc-post-activate-list}]
     305    if {[llength ${temp-proc-list}] > 0} {
     306        registry_prop_store $regref regproc-post-activate-list ${temp-proc-list}
     307    }
     308
     309    set temp-proc-list [munge_proc ${proc-pre-deactivate-list}]
     310    if {[llength ${temp-proc-list}] > 0} {
     311        registry_prop_store $regref regproc-pre-deactivate-list ${temp-proc-list}
     312    }
     313
     314    set temp-proc-list [munge_proc ${proc-post-deactivate-list}]
     315    if {[llength ${temp-proc-list}] > 0} {
     316        registry_prop_store $regref regproc-post-deactivate-list ${temp-proc-list}
     317    }
     318
     319    set temp-proc-list [munge_proc ${proc-pre-uninstall-list}]
     320    if {[llength ${temp-proc-list}] > 0} {
     321        registry_prop_store $regref regproc-pre-uninstall-list ${temp-proc-list}
     322    }
     323
     324    set temp-proc-list [munge_proc ${proc-post-uninstall-list}]
     325    if {[llength ${temp-proc-list}] > 0} {
     326        registry_prop_store $regref regproc-post-uninstall-list ${temp-proc-list}
     327    }
     328
    174329        registry_write $regref
    175330
     331    # also we still have the problem of post-install being run by
     332    # the target phase and by the activate procedure
     333    # rename the current post-install proc and define a dummy proc
     334    # do this in a separate loop as should only be run during the install phase
     335    set proc-post-install-list [info proc userproc-post-org.macports.install-install*]
     336    if {[llength ${proc-post-install-list}] > 0} {
     337        foreach oldname ${proc-post-install-list} {
     338            # we now need to redefine the procedure with new name
     339            set prcname [string map { userproc proc } $oldname ]
     340            set newname [string map { userproc nouseproc } $oldname ]
     341            rename $prcname $newname
     342            eval "proc $prcname {name} { return 0 }"
     343        }
     344    }
     345
     346        # this is the only way to solve the install/activate debacle
     347        # activate is strictly a sub-phase of install
     348        # - at the end of an install process most people would expect the
     349        # software to be fully installed
     350        # (similarly deactivate is a sub-phase of uninstall)
     351        # by calling the activate function at this point
     352        # (which then calls the current pre-/post-activate procs)
     353        # we end up with a fully installed port after the install phase
     354        # this solves the issue of non-image installations never calling
     355        # activate (or deactivate) - at least with other mods to portimage.tcl
     356        # note with this a post-install Portfile section is the last thing called
     357        # not post-activate
     358        # - but this also solves the problem of current post-activate sections
     359        # as they will still be called and if no post-install section is defined
     360        # they will be the last thing called
     361        # (which is mainly the case at present)
     362        # going forward this will mean the natural place to do actions after the
     363        # port is fully installed will be in a post-install section
     364
     365        install_activate args
     366
    176367    return 0
    177368}
    178369
    179 proc proc_disasm {pname} {
    180     set p "proc "
    181     append p $pname " \{"
    182     set space ""
    183     foreach arg [info args $pname] {
    184         if {[info default $pname $arg value]} {
    185             append p "$space{" [list $arg $value] "}"
    186         } else {
    187             append p $space $arg
    188         }
    189         set space " "
    190     }
    191     append p "\} \{" [info body $pname] "\}"
    192     return $p
     370# at end of install phase activate the image if doing image installs
     371
     372proc install_activate {args} {
     373        global portname portversion portrevision portvariants user_options
     374
     375        # in new implementation we always call activate - whether image or not
     376        # the post-install phase is called from there
     377        registry_activate $portname ${portversion}_${portrevision}${portvariants} [array get user_options]
     378
     379        return 0
    193380}
     381

  • base/src/port1.0/portutil.tcl

     
    646646    }
    647647}
    648648
     649########### Pre/Post proc functions ###########
     650# procedures for converting procs for saving in registry
     651# or in archive
     652
     653proc munge_proc {proc-list} {
     654    set temp-proc-list {}
     655    if {[llength ${proc-list}] > 0} {
     656        foreach prename ${proc-list} {
     657            lappend temp-proc-list [proc_disasm $prename]
     658        }
     659    }
     660    return ${temp-proc-list}
     661}
     662
     663# special proc for post-install procs - we have to convert the proc
     664# to allow for arguments
     665proc post_install_munge_proc {proc-post-install-list} {
     666    set temp-proc-list {}
     667    if {[llength ${proc-post-install-list}] > 0} {
     668        foreach oldname ${proc-post-install-list} {
     669            # munge body
     670            set curbody [info body $oldname]
     671            # we now need to redefine the procedure with new name
     672            set prename [string map { userproc regproc } $oldname ]
     673            if {[info proc $prename] == {}} {
     674                eval "proc $prename {portname portversion name version revision variants} { $curbody }"
     675            }
     676            lappend temp-proc-list [proc_disasm $prename]
     677        }
     678    }
     679    return ${temp-proc-list}
     680}
     681
     682# this procedure encodes the pre-/post- body so that it can be stored in the
     683# the receipt file
     684proc proc_disasm {pname} {
     685    set p "proc "
     686    append p $pname " {"
     687    set space ""
     688    foreach arg [info args $pname] {
     689        if {[info default $pname $arg value]} {
     690            append p "$space{" [list $arg $value] "}"
     691        } else {
     692            append p $space $arg
     693        }
     694        set space " "
     695    }
     696    append p "} {" [string map { \n \\n } [info body $pname] ] " }"
     697    return $p
     698}
     699
    649700########### Environment utility functions ###########
    650701
    651702# Parse the environment string of a command, storing the values into the

  • base/src/macports1.0/macports.tcl

     
    11871187### _mportinstalled is private; may change without notice
    11881188
    11891189# Determine if a port is already *installed*, as in "in the registry".
     1190# fix this up so that if image install we check if port is active
     1191# as far as I can see everywhere _mportinstalled is called is preceded by the check
     1192# for image installs and if image then _mportactive is called
     1193# this brings this into line with the concept activate is sub-phase of install
    11901194proc _mportinstalled {mport} {
    1191     # Check for the presense of the port in the registry
    1192     set workername [ditem_key $mport workername]
    1193     set res [$workername eval registry_exists \${portname} \${portversion}]
    1194     if {$res != 0} {
    1195         ui_debug "[ditem_key $mport provides] is installed"
    1196         return 1
     1195    if { [string equal ${macports::registry.installtype} "image"] } {
     1196       return [_mportactive $mport]
    11971197    } else {
    1198         return 0
     1198        # Check for the presense of the port in the registry
     1199        set workername [ditem_key $mport workername]
     1200        set res [$workername eval registry_exists \${portname} \${portversion}]
     1201        if {$res != 0} {
     1202            ui_debug "[ditem_key $mport provides] is installed"
     1203            return 1
     1204        } else {
     1205            return 0
     1206        }
    11991207    }
    12001208}
    12011209
    … …  
    12191227# depspec   the dependency test specification (path, bin, lib, etc.)
    12201228proc _mportispresent {mport depspec} {
    12211229    ui_debug "Searching for dependency: [ditem_key $mport provides]"
    1222     if {[string equal ${macports::registry.installtype} "image"]} {
    1223         set res [_mportactive $mport]
    1224     } else {
    1225         set res [_mportinstalled $mport]
    1226     }
     1230    set res [_mportinstalled $mport]
    12271231    if {$res != 0} {
    12281232        ui_debug "Found Dependency: receipt exists for [ditem_key $mport provides]"
    12291233        return 1
    … …  
    13101314        dlist_delete dlist $mport
    13111315
    13121316        # install them
    1313         # xxx: as with below, this is ugly.  and deps need to be fixed to
    1314         # understand Port Images before this can get prettier
    1315         if { [string equal ${macports::registry.installtype} "image"] } {
    1316             set result [dlist_eval $dlist _mportactive [list _mportexec "activate"]]
    1317         } else {
    1318             set result [dlist_eval $dlist _mportinstalled [list _mportexec "install"]]
    1319         }
    1320        
     1317        set result [dlist_eval $dlist _mportinstalled [list _mportexec "install"]]
     1318
    13211319        if {$result != {}} {
    13221320            set errstring "The following dependencies failed to build:"
    13231321            foreach ditem $result {
    … …  
    13391337        set clean 1
    13401338    }
    13411339
    1342     # If we're doing image installs, then we should activate after install
    1343     # xxx: This isn't pretty
    1344     if { [string equal ${macports::registry.installtype} "image"] && [string equal $target "install"] } {
    1345         set target activate
    1346     }
    1347    
    13481340    # Build this port with the specified target
    13491341    set result [$workername eval eval_targets $target]
    13501342