Ignore:
Timestamp:
Sep 28, 2002, 9:16:20 PM (16 years ago)
Author:
kevin
Message:

Enhanced options hooks

Allow multiple hooks for each option.
Call hook with option name, action, and list of parameters.

Added portfile class of depspec

First tests registry, then path, then builds.

Cleans before and after building portfile dependencies.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/port1.0/portutil.tcl

    r805 r821  
    5555    foreach option $args {
    5656        eval "proc $option {args} \{ \n\
    57             global ${option} user_options \n\
     57            global ${option} user_options option_procs \n\
    5858                \if \{!\[info exists user_options(${option})\]\} \{ \n\
    5959                     set ${option} \$args \n\
    60                          if \{\[info commands options::${option}\] != \"\"\} \{ \n\
    61                              options::${option} set \n\
     60                         if \{\[info exists option_procs($option)\]\} \{ \n\
     61                                foreach p \$option_procs($option) \{ \n\
     62                                        eval \"\$p $option set \$args\" \n\
     63                                \} \n\
    6264                         \} \n\
    6365                \} \n\
     
    7072                        ldelete ${option} \$val \n\
    7173                    \} \n\
    72                     if \{\[info commands options::${option}\] != \"\"\} \{ \n\
    73                         options::${option} delete \n\
    74                     \} \n\
     74                         if \{\[info exists option_procs($option)\]\} \{ \n\
     75                                foreach p \$option_procs($option) \{ \n\
     76                                        eval \"\$p $option delete \$args\" \n\
     77                                \} \n\
     78                         \} \n\
    7579                \} \n\
    7680        \}"
     
    7983                \if \{!\[info exists user_options(${option})\]\} \{ \n\
    8084                    set $option \[concat \$$option \$args\] \n\
    81                         if \{\[info commands options::${option}\] != \"\"\} \{ \n\
    82                             options::${option} append \n\
    83                         \} \n\
     85                         if \{\[info exists option_procs($option)\]\} \{ \n\
     86                                foreach p \$option_procs($option) \{ \n\
     87                                        eval \"\$p $option append \$args\" \n\
     88                                \} \n\
     89                         \} \n\
    8490                \} \n\
    8591        \}"
     
    94100        \}"
    95101    }
     102}
     103
     104proc option_proc {option args} {
     105        global option_procs
     106        eval "lappend option_procs($option) $args"
    96107}
    97108
     
    373384#       <identifier> requires <list of target names>
    374385#       <identifier> uses <list of target names>
     386#       <identifier> deplist <list of deplist names>
    375387#       <provides> preflight <proc name>
    376388#       <provides> postflight <proc name>
     
    471483            }
    472484        }
     485
     486        } elseif {$mode == "deplist"} {
     487                $obj append $mode $args
    473488       
    474489    } elseif {$mode == "preflight"} {
     
    579594# get_next_proc is used to determine the best item to run
    580595proc dlist_evaluate {dlist get_next_proc} {
    581 
     596        global portname
     597       
    582598    # status - keys will be node names, values will be {-1, 0, 1}.
    583599    array set statusdict [list]
     
    589605                                set statusdict($name) 1
    590606                        }
     607                        ldelete dlist $obj
    591608                }
    592609        }
     
    607624                       
    608625                        # Delete the item from the waiting list.
    609                         set i [lsearch $dlist $obj]
    610                         set dlist [lreplace $dlist $i $i]
     626                        ldelete dlist $obj
    611627                }
    612628    }
     
    614630        if {[llength $dlist] > 0} {
    615631                # somebody broke!
    616                 ui_info "Warning: the following items did not execute: "
     632                ui_info "Warning: the following items did not execute (for $portname): "
    617633                foreach obj $dlist {
    618634                        ui_info "[$obj get name] " -nonewline
     
    625641
    626642proc target_run {this} {
    627         global target_state_fd
     643        global target_state_fd portname
    628644        set result 0
    629645        set procedure [$this get procedure]
     
    637653                if {[check_statefile $name $target_state_fd]} {
    638654                        set result 0
    639                         ui_debug "Skipping completed $name"
     655                        ui_debug "Skipping completed $name ($portname)"
    640656                } else {
    641657                        # Execute pre-run procedure
     
    653669
    654670                        if {$result == 0} {
    655                                 ui_debug "Executing $name"
     671                                ui_debug "Executing $name ($portname)"
    656672                                set result [catch {$procedure $name}]
    657673                        }
     
    665681                        }
    666682                        # Execute post-run procedure
    667                         if {$result == 0 && [$this has postrun]} {
     683                        if {[$this has postrun] && $result == 0} {
    668684                                set postrun [$this get postrun]
    669685                                ui_debug "Executing $postrun"
     
    10111027
    10121028
     1029##### portfile depspec subclass #####
     1030global portfile_vtbl
     1031array set portfile_vtbl [array get depspec_vtbl]
     1032set portfile_vtbl(run) portfile_run
     1033set portfile_vtbl(test) portfile_test
     1034
     1035proc portfile_new {name} {
     1036        set obj [depspec_new $name]
     1037       
     1038        $obj set _vtbl portfile_vtbl
     1039       
     1040        return $obj
     1041}
     1042
     1043# build the specified portfile
     1044proc portfile_run {this} {
     1045        set portname [$this get name]
     1046       
     1047    ui_debug "Building $portname"
     1048    array set options [list]
     1049    array set variations [list]
     1050    array set portinfo [dportmatch ^$portname\$]
     1051    if {[array size portinfo] == 0} {
     1052        ui_error "Dependency $portname not found"
     1053        return -1
     1054    }
     1055    set porturl $portinfo(porturl)
     1056
     1057    set worker [dportopen $porturl options variations]
     1058        if {[catch {dportexec $worker clean} result] || $result != 0} {
     1059                ui_error "Clean of $portname before build failed: $result"
     1060                dportclose $worker
     1061                return -1
     1062    }
     1063        if {[catch {dportexec $worker install} result] || $result != 0} {
     1064                ui_error "Build of $portname failed: $result"
     1065                dportclose $worker
     1066                return -1
     1067        }
     1068        if {[catch {dportexec $worker clean} result] || $result != 0} {
     1069                ui_error "Clean of $portname after build failed: $result"
     1070    }
     1071    dportclose $worker
     1072       
     1073        return 0
     1074}
     1075
     1076proc portfile_test {this} {
     1077        set receipt [registry_exists [$this get name]]
     1078        if {$receipt != ""} {
     1079                ui_debug "Found Dependency: receipt: $receipt"
     1080                return 1
     1081        } else {
     1082                return 0
     1083        }
     1084}
     1085
     1086proc portfile_search_path {depregex search_path} {
     1087        set found 0
     1088    foreach path $search_path {
     1089                if {![file isdirectory $path]} {
     1090                        continue
     1091                }
     1092                foreach filename [readdir $path] {
     1093                        if {[regexp $depregex $filename] == 1} {
     1094                                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
     1095                                set found 1
     1096                                break
     1097                        }
     1098                }
     1099        }
     1100        return $found
     1101}
     1102
     1103
     1104
     1105##### lib portfile depspec subclass #####
     1106global libportfile_vtbl
     1107array set libportfile_vtbl [array get portfile_vtbl]
     1108set libportfile_vtbl(test) libportfile_test
     1109
     1110proc libportfile_new {name match} {
     1111        set obj [portfile_new $name]
     1112       
     1113        $obj set _vtbl libportfile_vtbl
     1114        $obj set depregex $match
     1115       
     1116        return $obj
     1117}
     1118
     1119# XXX - Architecture specific
     1120# XXX - Rely on information from internal defines in cctools/dyld:
     1121# define DEFAULT_FALLBACK_FRAMEWORK_PATH
     1122# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
     1123# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
     1124# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
     1125# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
     1126
     1127proc libportfile_test {this} {
     1128        global env prefix
     1129
     1130        # Check the registry first
     1131        set result [portfile_test $this]
     1132        if {$result == 1} {
     1133                return $result
     1134        } else {
     1135                # Not in the registry, check the library path.
     1136                set depregex [$this get depregex]
     1137               
     1138                if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
     1139                lappend search_path $env(DYLD_FRAMEWORK_PATH)
     1140                } else {
     1141                lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
     1142                }
     1143                if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
     1144                lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
     1145                }
     1146                if {[info exists env(DYLD_LIBRARY_PATH)]} {
     1147                lappend search_path $env(DYLD_LIBRARY_PATH)
     1148                } else {
     1149                lappend search_path /lib /usr/local/lib /lib /usr/lib /op/local/lib /usr/X11R6/lib ${prefix}/lib
     1150                }
     1151                if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
     1152                lappend search_path $env(DYLD_LIBRARY_PATH)
     1153                }
     1154                regsub {\.} $depregex {\.} depregex
     1155                set depregex \^$depregex.*\\.dylib\$
     1156
     1157                return [portfile_search_path $depregex $search_path]
     1158        }
     1159}
     1160
    10131161##### bin portfile depspec subclass #####
     1162global binportfile_vtbl
     1163array set binportfile_vtbl [array get portfile_vtbl]
     1164set binportfile_vtbl(test) binportfile_test
     1165
     1166proc binportfile_new {name match} {
     1167        set obj [portfile_new $name]
     1168       
     1169        $obj set _vtbl binportfile_vtbl
     1170        $obj set depregex $match
     1171
     1172        return $obj
     1173}
     1174
     1175proc binportfile_test {this} {
     1176        global env prefix
     1177
     1178        # Check the registry first
     1179        set result [portfile_test $this]
     1180        if {$result == 1} {
     1181                return $result
     1182        } else {
     1183                # Not in the registry, check the binary path.
     1184                set depregex [$this get depregex]
     1185
     1186                set search_path [split $env(PATH) :]
     1187                set depregex \^$depregex\$
     1188               
     1189                return [portfile_search_path $depregex $search_path]
     1190        }
     1191}
Note: See TracChangeset for help on using the changeset viewer.