package provides for the dynamic modification of a user’s environment via modulefiles.
| coll.tcl.in (modules-5.1.1.tar.bz2) | : | coll.tcl.in (modules-5.2.0.tar.bz2) |
|---|
| | |
| skipping to change at line 32 | | skipping to change at line 32 |
|---|
| # list, eventually checking element presence in extra from/to lists | | # list, eventually checking element presence in extra from/to lists |
| proc getMovementBetweenList {from to {extfrom {}} {extto {}} {cmp eq}} { | | proc getMovementBetweenList {from to {extfrom {}} {extto {}} {cmp eq}} { |
| reportDebug "from($from) to($to) with extfrom($extfrom) extto($extto)" | | reportDebug "from($from) to($to) with extfrom($extfrom) extto($extto)" |
| | |
| set undo {} | | set undo {} |
| set do {} | | set do {} |
| | |
| # determine what element to undo then do | | # determine what element to undo then do |
| # to restore a target list from a current list | | # to restore a target list from a current list |
| # with preservation of the element order | | # with preservation of the element order |
|
| | ##nagelfar ignore #2 Badly formed if statement |
| set imax [if {[llength $to] > [llength $from]} {llength $to} {llength\ | | set imax [if {[llength $to] > [llength $from]} {llength $to} {llength\ |
| $from}] | | $from}] |
| set list_equal 1 | | set list_equal 1 |
| for {set i 0} {$i < $imax} {incr i} { | | for {set i 0} {$i < $imax} {incr i} { |
| set to_obj [lindex $to $i] | | set to_obj [lindex $to $i] |
| set from_obj [lindex $from $i] | | set from_obj [lindex $from $i] |
| # check from/to element presence in extra from/to list | | # check from/to element presence in extra from/to list |
| set in_extfrom [expr {$from_obj in $extfrom}] | | set in_extfrom [expr {$from_obj in $extfrom}] |
| set in_extto [expr {$to_obj in $extto}] | | set in_extto [expr {$to_obj in $extto}] |
| # are elts the sames and are both part of or missing from extra lists | | # are elts the sames and are both part of or missing from extra lists |
| | |
| skipping to change at line 67 | | skipping to change at line 68 |
|---|
| | |
| return [list $undo $do] | | return [list $undo $do] |
| } | | } |
| | |
| # build list of currently loaded modules where modulename is registered minus | | # build list of currently loaded modules where modulename is registered minus |
| # module version if loaded version is the default one | | # module version if loaded version is the default one |
| proc getSimplifiedLoadedModuleList {} { | | proc getSimplifiedLoadedModuleList {} { |
| set curr_mod_list {} | | set curr_mod_list {} |
| array set curr_tag_arr {} | | array set curr_tag_arr {} |
| set modpathlist [getModulePathList] | | set modpathlist [getModulePathList] |
|
| foreach mod [getLoadedModuleList] { | | foreach mod [getLoadedModulePropertyList name] { |
| set altandsimplist [getLoadedAltAndSimplifiedName $mod] | | set altandsimplist [getLoadedAltAndSimplifiedName $mod] |
| | |
| set parentmod [file dirname $mod] | | set parentmod [file dirname $mod] |
| set simplemod $mod | | set simplemod $mod |
| # simplify to parent name as long as it is found in simplified name list | | # simplify to parent name as long as it is found in simplified name list |
| while {$parentmod ne {.}} { | | while {$parentmod ne {.}} { |
| if {$parentmod in $altandsimplist} { | | if {$parentmod in $altandsimplist} { |
| set simplemod $parentmod | | set simplemod $parentmod |
| set parentmod [file dirname $parentmod] | | set parentmod [file dirname $parentmod] |
| } else { | | } else { |
| | |
| skipping to change at line 99 | | skipping to change at line 100 |
|---|
| set curr_tag_arr($simplemodvr) $tag_list | | set curr_tag_arr($simplemodvr) $tag_list |
| } | | } |
| } | | } |
| | |
| return [list $curr_mod_list [array get curr_tag_arr]] | | return [list $curr_mod_list [array get curr_tag_arr]] |
| } | | } |
| | |
| # return saved collections found in user directory which corresponds to | | # return saved collections found in user directory which corresponds to |
| # enabled collection target if any set. extract one collection specifically | | # enabled collection target if any set. extract one collection specifically |
| # when search mode is set to exact. only compute collection name if mode is | | # when search mode is set to exact. only compute collection name if mode is |
|
| # set to name | | # set to name. translate collection name to __init__ if not found and |
| proc findCollections {{coll *} {search glob} {errnomatch 0} {checkvalid 1}} { | | # swap_by_init enabled. if no_other_target enabled, ensure no result from |
| | # other target are returned from glob search |
| | proc findCollections {{coll *} {search glob} {swap_by_init 0} {errnomatch 0}\ |
| | {checkvalid 1} {no_other_target 0}} { |
| # initialize description with collection name | | # initialize description with collection name |
| set colldesc $coll | | set colldesc $coll |
| | |
| if {$coll eq {}} { | | if {$coll eq {}} { |
| reportErrorAndExit [getEmptyNameMsg collection] | | reportErrorAndExit [getEmptyNameMsg collection] |
|
| | } elseif {$coll eq {__init__}} { |
| | set collfile $coll |
| | set colldesc {} |
| # is collection a filepath | | # is collection a filepath |
| } elseif {[string first / $coll] > -1} { | | } elseif {[string first / $coll] > -1} { |
| # collection target has no influence when | | # collection target has no influence when |
| # collection is specified as a filepath | | # collection is specified as a filepath |
| set collfile $coll | | set collfile $coll |
| # elsewhere collection is a name | | # elsewhere collection is a name |
| } elseif {[info exists ::env(HOME)]} { | | } elseif {[info exists ::env(HOME)]} { |
| set collfile $::env(HOME)/.module/$coll | | set collfile $::env(HOME)/.module/$coll |
|
| # find saved collections (matching target suffix) | | # find saved collections (matching target suffix). a target is a domain |
| # a target is a domain on which a collection is only valid. | | # on which a collection is only valid. when a target is set, only the |
| # when a target is set, only the collections made for that target | | # collections made for that target will be available to list and |
| # will be available to list and restore, and saving will register | | # restore, and saving will register the target footprint. current target |
| # the target footprint | | # is ignored if --all option is set on savelist command |
| set colltarget [getConf collection_target] | | set colltarget [getConf collection_target] |
|
| if {$colltarget ne {}} { | | if {$colltarget ne {} && ([getState hiding_threshold] < 2 ||\ |
| | [currentState commandname] ne {savelist})} { |
| append collfile .$colltarget | | append collfile .$colltarget |
| # add knowledge of collection target on description | | # add knowledge of collection target on description |
| append colldesc " (for target \"$colltarget\")" | | append colldesc " (for target \"$colltarget\")" |
| } | | } |
| } else { | | } else { |
| reportErrorAndExit {HOME not defined} | | reportErrorAndExit {HOME not defined} |
| } | | } |
| | |
|
| if {$search eq {glob}} { | | switch -- $search { |
| # glob excludes by default files starting with "." | | glob { |
| if {[catch {set clist [glob -nocomplain $collfile]} errMsg]} { | | # glob excludes by default files starting with "." |
| reportErrorAndExit "Cannot access collection directory.\n$errMsg" | | if {[catch {set clist [glob -nocomplain $collfile]} errMsg]} { |
| } else { | | reportErrorAndExit "Cannot access collection directory.\n$errMsg" |
| set res {} | | } else { |
| foreach cfile $clist { | | set res {} |
| if {[checkValidColl $cfile]} { | | foreach cfile $clist { |
| lappend res $cfile | | # test collection is from correct target or no target if |
| | # no_other_target is enabled |
| | set cfile_ext [string range [file extension $cfile] 1 end] |
| | if {(!$no_other_target || $cfile_ext eq [getConf\ |
| | collection_target]) && [checkValidColl $cfile]} { |
| | lappend res $cfile |
| | } |
| } | | } |
| } | | } |
| } | | } |
|
| } else { | | exact { |
| # verify that file exists | | if {$coll ne {__init__}} { |
| if {$search eq {exact}} { | | # verify that file exists |
| if {![file exists $collfile]} { | | if {![file exists $collfile]} { |
| if {$errnomatch} { | | if {$errnomatch} { |
| reportErrorAndExit "Collection $colldesc cannot be found" | | reportErrorAndExit "Collection $colldesc cannot be found" |
| } else { | | } else { |
| | set collfile {} |
| | } |
| | # error will be raised if collection not valid |
| | } elseif {$checkvalid && ![checkValidColl $collfile\ |
| | $errnomatch]} { |
| set collfile {} | | set collfile {} |
| } | | } |
|
| # error will be raised if collection no valid | | |
| } elseif {$checkvalid && ![checkValidColl $collfile $errnomatch]} { | | |
| set collfile {} | | |
| } | | } |
|
| | if {$collfile eq {} && $swap_by_init} { |
| | set collfile __init__ |
| | set colldesc {} |
| | } |
| | # return coll filename and its description for exact and name modes |
| | set res [list $collfile $colldesc] |
| | } |
| | name { |
| | set res [list $collfile $colldesc] |
| } | | } |
|
| # return coll filename and its description for exact and name modes | | |
| set res [list $collfile $colldesc] | | |
| } | | } |
| | |
| return $res | | return $res |
| } | | } |
| | |
| proc checkValidColl {collfile {report_issue 0}} { | | proc checkValidColl {collfile {report_issue 0}} { |
| set res 0 | | set res 0 |
| if {[catch { | | if {[catch { |
| set fdata [readFile $collfile 1] | | set fdata [readFile $collfile 1] |
| # extract magic cookie (first word) | | # extract magic cookie (first word) |
| | |
| skipping to change at line 233 | | skipping to change at line 256 |
|---|
| # prepend header if defined and some content has been generated | | # prepend header if defined and some content has been generated |
| if {[string length $header] != 0 && [string length $content] != 0} { | | if {[string length $header] != 0 && [string length $content] != 0} { |
| set content "$header\n$content" | | set content "$header\n$content" |
| } | | } |
| | |
| return $content | | return $content |
| } | | } |
| | |
| # read given collection file and return the path and module lists it defines | | # read given collection file and return the path and module lists it defines |
| proc readCollectionContent {collfile colldesc} { | | proc readCollectionContent {collfile colldesc} { |
|
| # init lists (maybe coll does not set mod to load) | | |
| set path_list {} | | |
| set mod_list {} | | |
| set nuasked_list {} | | |
| array set tag_arr {} | | |
| | | |
| # read file | | # read file |
| if {[catch { | | if {[catch { |
| set fdata [split [readFile $collfile] \n] | | set fdata [split [readFile $collfile] \n] |
| } errMsg ]} { | | } errMsg ]} { |
| reportErrorAndExit "Collection $colldesc cannot be read.\n$errMsg" | | reportErrorAndExit "Collection $colldesc cannot be read.\n$errMsg" |
| } | | } |
| | |
|
| | return [parseCollectionContent $fdata] |
| | } |
| | |
| | proc parseCollectionContent {fdata} { |
| | # init lists (maybe coll does not set mod to load) |
| | set path_list {} |
| | set mod_list {} |
| | set nuasked_list {} |
| | array set tag_arr {} |
| | |
| # analyze collection content | | # analyze collection content |
| foreach fline $fdata { | | foreach fline $fdata { |
| if {[regexp {module use (.*)$} $fline match patharg] == 1} { | | if {[regexp {module use (.*)$} $fline match patharg] == 1} { |
| # paths are appended by default | | # paths are appended by default |
| set stuff_path append | | set stuff_path append |
| # manage multiple paths and path options specified on single line, | | # manage multiple paths and path options specified on single line, |
| # for instance "module use --append path1 path2 path3", with list | | # for instance "module use --append path1 path2 path3", with list |
| # representation of patharg (which handles quoted elements containing | | # representation of patharg (which handles quoted elements containing |
| # space in their name) | | # space in their name) |
| foreach path $patharg { | | foreach path $patharg { |
| | |
| skipping to change at line 306 | | skipping to change at line 333 |
|---|
| set parsedlist [parseModuleSpecification 0 {*}$cleanlist] | | set parsedlist [parseModuleSpecification 0 {*}$cleanlist] |
| foreach parsed $parsedlist { | | foreach parsed $parsedlist { |
| set tag_arr($parsed) $tag_list | | set tag_arr($parsed) $tag_list |
| } | | } |
| lappend mod_list {*}$parsedlist | | lappend mod_list {*}$parsedlist |
| } | | } |
| } | | } |
| return [list $path_list $mod_list [array get tag_arr]] | | return [list $path_list $mod_list [array get tag_arr]] |
| } | | } |
| | |
|
| | # return specified collection content and differences compared to currently |
| | # defined environment |
| | proc getDiffBetweenCurEnvAndColl {collfile colldesc} { |
| | # read specific __init__ collection from __MODULES_LMINIT env var |
| | if {$collfile eq {__init__}} { |
| | lassign [parseCollectionContent [getLoadedModulePropertyList init]]\ |
| | coll_path_list coll_mod_list coll_tag_arrser |
| | } else { |
| | lassign [readCollectionContent $collfile $colldesc] coll_path_list\ |
| | coll_mod_list coll_tag_arrser |
| | } |
| | |
| | # build list of module tagged auto-loaded in collection |
| | array set coll_tag_arr $coll_tag_arrser |
| | set coll_nuasked_list {} |
| | foreach mod [array names coll_tag_arr] { |
| | if {{auto-loaded} in $coll_tag_arr($mod)} { |
| | lappend coll_nuasked_list $mod |
| | } |
| | } |
| | |
| | # collection should at least define a path or a mod, but initial env may be |
| | # totally empty |
| | if {$collfile ne {__init__} && [llength $coll_path_list] == 0 && [llength\ |
| | $coll_mod_list] == 0} { |
| | reportErrorAndExit "$colldesc is not a valid collection" |
| | } |
| | |
| | # load tags from loaded modules |
| | cacheCurrentModules |
| | |
| | defineModEqProc [isIcase] [getConf extended_default] |
| | |
| | # fetch what is currently loaded |
| | set curr_path_list [getModulePathList returnempty 0] |
| | # get current loaded module list |
| | set curr_mod_list [getLoadedModulePropertyList name] |
| | set curr_nuasked_list [getTaggedLoadedModuleList auto-loaded] |
| | # get current save tags of loaded modules |
| | array set curr_tag_arr [getLoadedModuleWithVariantSaveTagArrayList] |
| | |
| | # determine what module to unload to restore collection from current |
| | # situation with preservation of the load order (asking for a modeq |
| | # comparison will help to check against simplified mod name and variants) |
| | lassign [getMovementBetweenList $curr_mod_list $coll_mod_list\ |
| | $curr_nuasked_list $coll_nuasked_list modeq] mod_to_unload mod_to_load |
| | |
| | # proceed as well for modulepath |
| | lassign [getMovementBetweenList $curr_path_list $coll_path_list] \ |
| | path_to_unuse path_to_use |
| | |
| | # indicate if loaded modules that matches modules in collection have |
| | # different tags set |
| | if {[llength $mod_to_load] == 0} { |
| | # consider a not-set entry as an empty element when comparing collection |
| | # and current environment tags. compare tags as unordered lists |
| | lassign [getDiffBetweenArray curr_tag_arr coll_tag_arr 1 1] notincoll\ |
| | diff notincurr |
| | set is_tags_diff [expr {[llength $diff] > 0}] |
| | # if some module from collection are not yet loaded, consider there is a |
| | # difference |
| | } else { |
| | set is_tags_diff 1 |
| | } |
| | |
| | return [list $coll_path_list $coll_mod_list $coll_tag_arrser\ |
| | $coll_nuasked_list $mod_to_unload $mod_to_load $path_to_unuse\ |
| | $path_to_use $is_tags_diff] |
| | } |
| | |
| | proc getCollectionFromStash {stash} { |
| | if {[string match stash-* $stash]} { |
| | set coll $stash |
| | } elseif {[string is integer -strict $stash]} { |
| | # filter collection from other target (especially if no target set) |
| | set collfile [lindex [lsort -decreasing [findCollections stash-* glob\ |
| | 0 0 1 1]] $stash] |
| | if {$collfile eq {}} { |
| | knerror "Invalid stash index '$stash'" |
| | } |
| | # extract collection name (without path and target extension) |
| | set coll [file rootname [file tail $collfile]] |
| | } else { |
| | knerror "Invalid stash collection name '$stash'" |
| | } |
| | |
| | return $coll |
| | } |
| | |
| # ;;; Local Variables: *** | | # ;;; Local Variables: *** |
| # ;;; mode:tcl *** | | # ;;; mode:tcl *** |
| # ;;; End: *** | | # ;;; End: *** |
| # vim:set tabstop=3 shiftwidth=3 expandtab autoindent: | | # vim:set tabstop=3 shiftwidth=3 expandtab autoindent: |
| | | |
| End of changes. 14 change blocks. |
|---|
| 36 lines changed or deleted | | 152 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 