--- /dev/null
+;#
+;# (((((((((((( M A G I C ))))))))))))
+;#
+;# Poor parsing of a magic file. Returns the list of all extensions found after -name directive.
+;# mgfile returned by wokBAG:magic:Name
+;#
+proc wokBAG:magic:Parse { mgfile } {
+ if [ catch { set fileid [open $mgfile r] } ] {
+ return {}
+ }
+ set lx {}
+ foreach x [split [read $fileid] ] {
+ if { ([string compare $x "-name"] == 0 ) || ( [string compare $x "(-name"] == 0 ) } {
+ set name 1
+ } else {
+ if [info exists name] {
+ regsub -all {[");]} $x "" res
+ set lx [concat $lx $res]
+ unset name
+ }
+ }
+ }
+ close $fileid
+ return $lx
+}
+;#
+;# returns the list of Known EXtension
+;#
+proc wokBAG:magic:kex { } {
+ set l {}
+ foreach mgfile [wokBAG:magic:Name] {
+ if [file exists $mgfile] {
+ set l [concat $l [wokBAG:magic:Parse $mgfile]]
+ } else {
+ puts stderr "Magic: File $mgfile not found"
+ }
+ }
+ return $l
+}
+;#
+;# Given a list of extension, returns the sublist of unknown extensions
+;# If this sublist is {} then all extensions are known.
+;# Plus merdique, tu meurs a virer des que possible.
+;#
+proc wokBAG:magic:CheckExt { lxt } {
+ set kex [wokBAG:magic:kex]
+ set l {}
+
+ foreach e $lxt {
+ set fnd 0
+ foreach x $kex {
+ if { [string match $x $e] } {
+ set fnd 1
+ break
+ }
+ }
+ if { $fnd == 0 } {
+ set l [concat $l $e]
+ }
+ }
+
+ return $l
+}
+;#
+;# (((((((((((( A D M I N ))))))))))))
+;#
+proc wokBAG:admin:Create {} {
+ global tcl_platform
+ set NAM [wokBAG:admin:Name]
+ set TAG [file join [wokBAG:bag:GetRootTagName] $NAM]
+ set VBS [file join [wokBAG:bag:GetAdmName] ${NAM}.vbs]
+ set VWR [wokBAG:view:GetRootName]
+ if { "$tcl_platform(platform)" == "unix" } {
+ if ![file exists $TAG] {
+ if [catch {mkdir -path $TAG} tag_stat] {
+ puts stderr ${tag_stat}
+ return {}
+ }
+ }
+ if ![file exists [wokBAG:bag:GetAdmName]] {
+ if [catch {mkdir -path [wokBAG:bag:GetAdmName]} vbs_stat ] {
+ puts stderr ${vbs_stat}
+ return {}
+ }
+ }
+ }
+ lappend l "cleartool mkvob -nc -tag $TAG $VBS"
+ lappend l "cleartool mount $TAG"
+ lappend l "cleartool co -nc $VWR/[wokBAG:view:GetViewImport]${TAG}"
+ lappend l "cleartool mkelem -eltype directory -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/JOURNAL"
+ lappend l "cleartool mkelem -eltype directory -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/CONFIGS"
+ lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/JOURNAL"
+ lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/CONFIGS"
+ lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}"
+ return $l
+}
+;#
+;# (((((((((((( H L I N K ))))))))))))
+;#
+;# returns the sequence used to initialize the link for pnam
+;#
+proc wokBAG:hlink:Init { pnam } {
+ set NAM [wokBAG:admin:Name]
+ set TAG [file join [wokBAG:bag:GetRootTagName] $NAM]
+ lappend l "cleartool mkhltype -nc -shared [wokBAG:hlink:Umaked $pnam]@$TAG"
+}
+;# returns the string that identify the link used to reflect build dependencies of pnam
+;# This module uses journal definition.
+;#
+proc wokBAG:hlink:Umaked { pnam } {
+ return ${pnam}_umakedwith
+}
+;#
+;# Link
+;# from, lto : Versionned composant name
+;# Example : from = s_1 r_2
+;# set from /view/IMPORT/dl_07/REFERENCE/BAG/ADMIN/JOURNAL/s.jnl@@/s_1
+;# set to /view/IMPORT/dl_07/REFERENCE/BAG/ADMIN/JOURNAL/r.jnl@@/r_2
+;# set command "cleartool mkhlink -nc umaked $from $to"
+;# set command "cleartool mkhlink -nc umake_s $from $to"
+
+proc wokBAG:hlink:Attach { pfrom lpto } {
+ if [regexp {([^_]*)_([0-9]*)} $pfrom all nfrom vfrom] {
+ set from [wokBAG:journal:name $nfrom]@@/${pfrom}
+ set hnam [wokBAG:hlink:Umaked $nfrom]
+ foreach pto $lpto {
+ if [regexp {([^_]*)_([0-9]*)} $pto all npto vpto] {
+ set to [wokBAG:journal:name $npto]@@/${pto}
+ lappend l "cleartool mkhlink -nc $hnam $from $to"
+ } else {
+ puts stderr "hlink:Attach(to) : Error in component name $pto"
+ return {}
+ }
+ }
+ return $l
+ } else {
+ puts stderr "hlink:Attach(from) : Error in component name $pfrom"
+ return {}
+ }
+}
+;#
+;# (((((((((((( L A B E L S ))))))))))))
+;#
+;# returns the tag name of the VOB where labels are managed.
+;# This VOB should be public.
+;#
+proc wokBAG:label:GetAdminVOB { } {
+ return [file join [wokBAG:bag:GetRootTagName] [wokBAG:admin:Name]]
+}
+;#
+;# Returns all labels that match regexp
+;#
+proc wokBAG:label:ls { {rgx *} } {
+ set command "cleartool lstype -short -kind lbtype -invob [wokBAG:label:GetAdminVOB]"
+ if ![catch { eval exec $command } status ] {
+ set lret {}
+ foreach e [wokUtils:LIST:GM [split $status \n] $rgx] {
+ lappend lret [lindex [split $e] 0]
+ }
+ return $lret
+ } else {
+ puts stderr "$status"
+ return -1
+ }
+}
+
+;#
+;# Returns all kwown labels
+;# writes map(pnam) = list of kwown labels for pnam
+;# opt should be short or long
+;#
+proc wokBAG:label:dump { map opt } {
+ upvar $map TLOC
+ catch { unset TLOC }
+ set command "cleartool lstype -$opt -kind lbtype -invob [wokBAG:label:GetAdminVOB]"
+ if ![catch { eval exec $command } status ] {
+ if { "$opt" == "short" } {
+ foreach e [split $status \n] {
+ if [regexp {([^_]*)_([0-9]*)} $e all n v] {
+ lappend TLOC($n) $v
+ }
+ }
+ foreach nam [array names TLOC] {
+ set TLOC($nam) [lsort -integer $TLOC($nam)]
+ }
+ } elseif { "$opt" == "long" } {
+ foreach e [split $status \n] {
+ if [regexp {^label type "(.*)"} $e match label] {
+ set curlabel $label
+ } elseif { [regexp {^ ([^ ]*) by (.*)} $e match date byandwhere] } {
+ if { "$curlabel" != "LATEST" && "$curlabel" != "CHECKEDOUT" } {
+ set TLOC($date) "$curlabel $byandwhere"
+ }
+ }
+ }
+ }
+
+ } else {
+ puts stderr "$status"
+ return -1
+ }
+}
+;#
+;# Init a label in Admin VOB.
+;#
+proc wokBAG:label:Init { name } {
+ lappend l "cleartool mklbtype -global -nc ${name}@[wokBAG:label:GetAdminVOB]"
+ return $l
+}
+;#
+;# Pose un label. name doit exister. (wokBAG:label:Add)
+;#
+proc wokBAG:label:Stick { name dir } {
+ lappend l "cleartool mklabel -nc -rec $name $dir"
+ lappend l "cleartool lock lbtype:${name}@$dir"
+ return $l
+}
+;#
+;# Delete a label.
+;#
+proc wokBAG:label:Del { name } {
+ lappend l "cleartool rmtype -nc lbtype:${name}@[wokBAG:label:GetAdminVOB]"
+ return $l
+}
+
+;#
+;# (((((((((((( L E V E L S ))))))))))))
+;#
+;#
+;# Initialise les fichiers LEVEL.CFG (BASE.K4E, etc.. ) dans le repertoire ADMIN/CONFIG
+;# i. e. cree les fichiers LEVEL.CFGi pour i dans LCFG (K4E K4F etc..)
+;#
+proc wokBAG:level:Init { level cfg from } {
+ lappend l "cleartool co -nc [wokBAG:level:dirname]"
+ lappend l "cleartool mkelem -eltype text_file -nc [wokBAG:level:file $level $cfg]"
+ lappend l "cleartool ci -ide -rm -nc -from $from [wokBAG:level:file $level $cfg]"
+ lappend l "cleartool ci -nc [wokBAG:level:dirname]"
+ return $l
+}
+;#
+;# Update le level <level> avec le contenu de from
+;# <flevel> : fichier associe au level
+;# <from> : nouveau contenu
+;# <
+proc wokBAG:level:update { flevel from } {
+ lappend l "cleartool co -nc $flevel"
+ lappend l "cleartool ci -nc -rm -ide -from $from $flevel"
+ return $l
+}
+
+;#
+;# Retourne le full path du fichier decrivant level dans la config cfg
+;# si ce
+;# 2. le nomune liste destinee a remplacer l'ancien contenu du fichier
+;# lbf est de la forme pnam_x
+;#
+proc wokBAG:level:file { level cfg } {
+ return [file join [wokBAG:level:dirname] ${level}.${cfg}]
+}
+;#
+;# Retourne le nom du directory ou sont stockes les levels/configs
+;# penser a mettre le file le join sur NT c'est plus sur.
+;#
+proc wokBAG:level:dirname { } {
+ set vws [wokBAG:view:GetRootName]
+ return $vws/[wokBAG:view:GetViewImport]/[wokBAG:bag:GetRootTagName]/[wokBAG:admin:Name]/CONFIGS
+}
+;#
+;# Retourne 2 elements
+;# 1. le full path du fichier contenant lbf pour la config cfg (celui a modifier)
+;# 2. une liste destinee a remplacer l'ancien contenu du fichier
+;# lbf est de la forme pnam_x
+;#
+proc wokBAG:level:find { pnam_x cfg } {
+ set pnam [wokBAG:cpnt:parse basename ${pnam_x}]
+ foreach file [wokBAG:level:ls $cfg] {
+ set lin [wokUtils:FILES:FileToList $file]
+ if [array exists map] { unset map }
+ set lxp [wokBAG:cpnt:explode $lin map]
+ if [info exists map($pnam)] {
+ set map($pnam) [wokBAG:cpnt:parse version ${pnam_x}]
+ set newl [wokBAG:cpnt:implode map]
+ return [list $file $newl]
+ }
+ }
+ return {}
+}
+;# Retourne le full path des fichiers de description correspondants a la config <cfg>
+;# i. e. tous les fichiers de noms XXX.cfg
+;#
+proc wokBAG:level:ls { cfg } {
+ return [glob -nocomplain [wokBAG:level:dirname]/*.${cfg}]
+}
+;#
+;# (((((((((((( J O U R N A L ))))))))))))
+;#
+;# Initialise la premiere version de journal associee a pnam.
+;#
+proc wokBAG:journal:Init { pnam jnl } {
+ set jnam [wokBAG:journal:name $pnam]
+ lappend l "cleartool co -nc [file dirname $jnam]"
+ lappend l "cleartool mkelem -nc $jnam"
+ lappend l "cleartool ci -ide -rm -nc -from $jnl $jnam"
+ lappend l "cleartool ci -nc [file dirname $jnam]"
+ return $l
+}
+;#
+;# Update le journal associe a pnam.
+;#
+proc wokBAG:journal:Update { pnam jnl } {
+ set jnam [wokBAG:journal:name $pnam]
+ lappend l "cleartool co -nc $jnam"
+ lappend l "cleartool ci -ide -rm -nc -from $jnl $jnam"
+ return $l
+}
+
+;#
+;# Retourne le nom du journal associe a pnam.
+;#
+proc wokBAG:journal:name { pnam } {
+ set vws [wokBAG:view:GetRootName]
+ return $vws/[wokBAG:view:GetViewImport]/[wokBAG:bag:GetRootTagName]/[wokBAG:admin:Name]/JOURNAL/${pnam}.jnl
+}
+;#
+;# retourne le full path du journal associe a pnam_x
+;#
+proc wokBAG:journal:read { pnam_x } {
+ set nam [wokBAG:cpnt:parse basename ${pnam_x}]
+ return [wokBAG:journal:name $nam]@@/main/[wokBAG:cpnt:parse version ${pnam_x}]
+}
+;#
+;# (((((((((((( V I E W S ))))))))))))
+;#
+proc wokBAG:view:Init { vnam {location {}} } {
+ if { $location != {} } {
+ set vws [file join [$location ${vnam}.vws]]
+ } else {
+ set vws [file join [wokBAG:bag:GetAdmName] ${vnam}.vws]
+ }
+ lappend l "cleartool mkview -tag $vnam $vws"
+ return $l
+}
+;#
+;# Configure la vue <tag> avec le fichier configspec <file>
+;#
+proc wokBAG:view:setcs { file { tag {} } } {
+ if { $tag == {} } {
+ lappend l "cleartool setcs $file"
+ } else {
+ lappend l "cleartool setcs -tag $tag $file"
+ }
+ return $l
+}
+;#
+;#
+;#
+proc wokBAG:view:startview { view } {
+ lappend l "cleartool startview $view"
+}
+;#
+;#
+;#
+proc wokBAG:view:endview { view } {
+ lappend l "cleartool endview $view"
+}
+;#
+;# (((((((((((( C O M P O N E N T S ))))))))))))
+;#
+;#
+;# Retourne le vob-tag associe a pnam
+;#
+proc wokBAG:cpnt:GetTagName { pnam } {
+ return [file join [wokBAG:bag:GetRootTagName] ${pnam}]
+}
+;#
+;# Retourne le directory avec lequel faut comparer dans la VOB
+;#
+proc wokBAG:cpnt:GetImportName { pnam } {
+ return [wokBAG:view:GetRootName]/[wokBAG:view:GetViewImport][wokBAG:cpnt:GetTagName $pnam]
+}
+;#
+;# Retourne le directory dans lequel il faut prendre les fichiers de pnam relativement la vue d'export.
+;#
+proc wokBAG:cpnt:GetExportName { pnam } {
+ return [wokBAG:view:GetRootName]/[wokBAG:view:GetViewExport][wokBAG:cpnt:GetTagName $pnam]
+}
+;#
+;# Init d'un composant.
+;# pnam : Nom du composant ( racine du directory dans la VOB)
+;# from : Nom d'une racine
+;# cvt_data: Nom du directory ou ecrire le fichier cvt_data de clearexport
+;# cmt : Un commentaire
+;# LAM : faudrait voir a faire les mkdir sinon ca marchera pas.
+;# le cd est fait dans pintegre c'est moche mais en attendant mieux.
+;#
+proc wokBAG:cpnt:Init { pnam from cvt_data {cmt Init} {location {}} } {
+ global tcl_platform
+ set tag [wokBAG:cpnt:GetTagName $pnam]
+ if { $location != {} } {
+ set vbs [file join [$location ${pnam}.vbs]]
+ } else {
+ set vbs [file join [wokBAG:bag:GetAdmName] ${pnam}.vbs]
+ }
+ if { "$tcl_platform(platform)" == "unix" } {
+ if ![file exists $tag] {
+ catch { mkdir -path $tag }
+ }
+ if ![file exists $vbs] {
+ catch { mkdir -path [file dirname $vbs] }
+ }
+ }
+ ;#lappend l "cleartool mkvob -tag $tag -nc -public -password $passwd $vbs"
+ lappend l "cleartool mkvob -nc -tag $tag $vbs"
+ lappend l "cleartool mount $tag"
+ lappend l "cleartool mkhlink AdminVOB vob:${tag} vob:[wokBAG:label:GetAdminVOB]"
+ ;#lappend l "cd $from"
+ lappend l "clearexport_ffile -r -o $cvt_data ."
+ lappend l "cleartool startview [wokBAG:view:GetViewImport]"
+ lappend l "clearimport -dir [wokBAG:cpnt:GetImportName $pnam] -comment \"$cmt\" $cvt_data"
+ return $l
+}
+;#
+;#
+;#
+proc wokBAG:cpnt:sortnam { pnam1 pnam2 } {
+ if { [lindex [split $pnam1 _] end] > [lindex [split $pnam2 _] end] } {
+ return -1
+ } else {
+ return 1
+ }
+}
+;#
+;#
+;#
+proc wokBAG:cpnt:Del { pnam } {
+ lappend l "cleartool umount [wokBAG:bag:GetRootTagName]/${pnam}"
+ lappend l "cleartool rmvob -force [file join [wokBAG:bag:GetAdmName] ${pnam}.vbs]"
+ return $l
+}
+;#
+;# Returns the list of "patches" registered for pnam (Patch 0 is the version base.)
+;# pnam is a component name without version ( no _)
+;#
+proc wokBAG:cpnt:Patches { pnam {upto 99999} } {
+ set l {}
+ foreach x [wokBAG:label:ls ${pnam}_*] {
+ if { [lindex [split $x _] end] <= $upto } {
+ lappend l [file tail $x]
+ }
+ }
+ return [lsort -command wokBAG:cpnt:sortnam $l]
+}
+;#
+;# Returns the name of the label to place on pnam (_1 is the base version.)
+;# pnam is a component name without version ( no _)
+;#
+proc wokBAG:cpnt:GetLabel { pnam } {
+ set llp [wokBAG:cpnt:Patches $pnam]
+ if { $llp != {} } {
+ set n [lindex [split [lindex [wokBAG:cpnt:Patches $pnam] 0] _] 1]
+ return ${pnam}_[incr n]
+ } else {
+ return ${pnam}_1
+ }
+}
+;#
+;# fait a_1 b_2 c_3 => map(a)=1,map(b)=2, map(c)=3 Comme parse ci dessous
+;#
+proc wokBAG:cpnt:explode { lpnam_x map } {
+ upvar $map TLOC
+ foreach pnam_x ${lpnam_x} {
+ set TLOC([lindex [split ${pnam_x} _] 0]) [lindex [split ${pnam_x} _] 1]
+ }
+ return
+}
+;#
+;# fait map(a)=1,map(b)=2, map(c)=3 => a_1 b_2 c_3 (inverse de ci dessus)
+;#
+proc wokBAG:cpnt:implode { map } {
+ upvar $map TLOC
+ set l {}
+ foreach n [array names TLOC] {
+ lappend l ${n}_$TLOC($n)
+ }
+ return $l
+}
+;#
+;# Parse un nom d'UL a la JCR.
+;# KERNEL-B4-2_8 => root=KERNEL,basename=KERNEL-B4-2,extension=B4-2,version=8
+;# KERNEL-B4-2 => root=KERNEL,basename=KERNEL-B4-2,extension=B4-2,version={}
+;# KERNEL => root=KERNEL,basename={} ,extension={} ,version={}
+proc wokBAG:cpnt:parse { option pnam_x } {
+ if { [regexp {([^-]*)-([^_]*)_([0-9]+)} ${pnam_x} a r e v] != 0 } {
+ switch -- $option {
+ root { return $r }
+ extension { return $e }
+ version { return $v }
+ basename { return ${r}-${e} }
+ }
+ } elseif { [regexp {([^-]*)-([^_]*)} ${pnam_x} a r e] != 0 } {
+ switch -- $option {
+ root { return $r }
+ extension { return $e }
+ version { return {} }
+ basename { return ${r}-${e} }
+ }
+ } else {
+ return {}
+ }
+}
+;#
+;# Update directory dir ( which already exists in VOB ) with files in lfile.
+;# Each element of lfile (non empty ) has the following format:
+;# <sta> basn name1 [name2]
+;# sta is # - or + if the file must be (resp ) modified, removed or added.
+;# if the file must be modified:
+;# name1/basn is the full path of the VOB element to be checkouted
+;# name2/basn is the full path of the file used for update
+;# if the file must be removed:
+;# name1/basn is the full path of the VOB element to be removed.
+;# name2 is blank
+;# if the file must be added:
+;# name1/basn is the full path of the file used for the creation.
+;#
+;#
+proc wokBAG:cpnt:UpdateDirectory { dir lfile } {
+ set l {}
+ foreach e $lfile {
+ if [regexp { #[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem from] {
+ lappend l "cleartool co -nc [file join $elem $basn]"
+ lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $elem $basn]"
+ } elseif [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] {
+ set mustco 1
+ lappend l "cleartool rmname -nc [file join $elem $basn]"
+ } elseif [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] {
+ set mustco 1
+ lappend l "cleartool mkelem -nc [file join $dir $basn]"
+ lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $dir $basn]"
+ } else {
+ puts stderr "wokBAG:cpnt:UpdateDirectory: Line $e does not match anything !!"
+ return {}
+ }
+ }
+
+ if [info exists mustco] {
+ lappend l "cleartool ci -nc $dir"
+ return [linsert $l 0 "cleartool co -nc $dir"]
+ } else {
+ return $l
+ }
+}
+;#
+;# Creates a directory and populates it with new files.
+;#
+proc wokBAG:cpnt:CreateDirectory { dir lfile } {
+ lappend l "cleartool co -nc [file dirname $dir]"
+ lappend l "cleartool mkelem -nc -eltype directory $dir"
+ foreach e $lfile {
+ if [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] {
+ lappend l "cleartool mkelem -nc [file join $dir $basn]"
+ lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $dir $basn]"
+ } else {
+ puts stderr "wokBAG:cpnt:CreateDirectory: Line $e does not match anything !!"
+ return {}
+ }
+ }
+ lappend l "cleartool ci -nc $dir"
+ lappend l "cleartool ci -nc [file dirname $dir]"
+}
+;#
+;# Removes all files in dir and removes directory itself.
+;#
+proc wokBAG:cpnt:DeleteDirectory { dir lfile } {
+ lappend l "cleartool co -nc [file dirname $dir]"
+ lappend l "cleartool rmname -nc $dir"
+ lappend l "cleartool ci -nc [file dirname $dir]"
+}
+;# (((((((((((( C O N F I G ))))))))))))
+;#
+;# <name> : The name of the config K4E, ..
+;#
+;# If Option is "strong" => then complete only if component already exists in Bag.
+;# If Option is "weak" => then ignore components not found in the Bag.
+;#
+proc wokBAG:cfg:Complete { name cmplst {option "strong"} } {
+ set l {}
+ wokBAG:cpnt:explode [wokBAG:cfg:read $name] LABELS
+ foreach pnam $cmplst {
+ if [regexp {([^_]*)_([0-9]*)} $pnam all n v] {
+ if [info exists LABELS($n)] {
+ if { $v <= $LABELS($n) } {
+ set l [concat $l $pnam]
+ } else {
+ puts stderr "Error: Patch level $v for $n does not exists. Higher level is $LABELS($n)"
+ return {}
+ }
+ } else {
+ puts stderr "Error: $n is not a component."
+ if { "$option" == "strong" } {
+ return {}
+ }
+ }
+ } else {
+ if [info exists LABELS($pnam)] {
+ set l [concat $l ${pnam}_$LABELS($pnam)]
+ } else {
+ puts stderr "Error: $pnam is not a component."
+ if { "$option" == "strong" } {
+ return {}
+ }
+ }
+ }
+ }
+ return $l
+}
+;#
+;# Returns all pnam_x belonging to assembly/config name
+;# first is the name of configuration ( K4E, K4F ,.. )
+;# vrs is the version number of the configuratrion
+;# if vrs {} then use LATEST.
+;#
+proc wokBAG:cfg:read { name {vrs {}} } {
+ set l {}
+ foreach x [wokBAG:level:ls $name] {
+ set l [concat $l [wokUtils:FILES:FileToList $x]]
+ }
+ return $l
+}
+;#
+;# ecrit un config spec. lfpnam list de full path de composants dans le Bag
+;#
+proc wokBAG:cfg:ListToConfig { lfpnam file } {
+ set l {}
+ foreach pnam $lfpnam {
+ lappend l "element * $pnam -nocheckout"
+ }
+ wokUtils:FILES:ListToFile $l $file
+ return
+}
+;# (((((((((((( E R R O R L O G ))))))))))))
+;#
+;#
+proc wokBAG:errlog:ls { } {
+ foreach f [readdir [wokBAG:errlog:location]] {
+ puts $f
+ }
+}
+;#
+;#
+;#
+proc wokBAG:errlog:purge { } {
+ foreach f [glob [wokBAG:errlog:location]/*] {
+ unlink $f
+ }
+}
+;#
+;#
+;#
+proc wokBAG:errlog:Add { pnam } {
+ set p [file join [wokBAG:errlog:location] ${pnam}.[clock seconds]]
+ if ![ catch { set id [ open $p w ] } ] {
+ return $id
+ } else {
+ return {}
+ }
+}
+proc wokBAG:errlog:Regexp { } {
+ set rg1 {cleartool: Error:}
+}
--- /dev/null
+
+#############################################################################
+#
+# P A D M I N
+# ___________
+#
+#############################################################################
+#
+# Usage
+#
+proc padminUsage { } {
+ puts stderr \
+ {
+ Usage : padmin [ options ... ] [pnam,...]
+
+ This command operates on elements in the central BAG.
+
+ Components: A component represents an UL and all its versions
+
+ -param : List parameters relative to the BAG.
+
+ -ls : List kwown components.
+ -rm : Deletes the components pnam1,pnam2 ... This will destroy the VOB associated and all
+ label attached to it in the Admin VOB.
+
+ -mkadm : Creates the vob administration.
+
+ -noexec : Don't execute. Only display script file.
+
+ Types: Set of rules used to store files.
+
+ -lsext : List known extensions. For more information, use -magic and explore
+ the magic file.
+
+
+ }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc padmin { args } {
+
+ set tblreq(-h) {}
+
+ set tblreq(-mkadm) {}
+ set tblreq(-noexec) {}
+ set tblreq(-rm) value_required:list
+
+ set tblreq(-lsext) {}
+
+ set tblreq(-ls) value_required:string
+
+ set tblreq(-magic) {}
+
+ set tblreq(-param) {}
+
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq padminUsage $args] == -1 } return
+
+ if { [info exists tabarg(-h)] } {
+ padminUsage
+ return
+ }
+
+ if { [info exists tabarg(-param)] } {
+ padmin:param
+ return
+ }
+
+
+ set execute 1
+ if { [info exists tabarg(-noexec)] } { set execute 0 }
+
+ if { [info exists tabarg(-mkadm)] } {
+ set lvws [concat [wokBAG:view:Init IMPORT] [wokBAG:view:Init EXPORT]]
+ padmin:execute [wokUtils:EASY:stobs2 $lvws] $execute
+ set ladm [wokBAG:admin:Create]
+ padmin:execute [wokUtils:EASY:stobs2 $ladm] $execute
+ return
+ }
+
+ if { [info exist tabarg(-rm)] } {
+ foreach pnam $tabarg(-rm) {
+ set res [wokBAG:cpnt:Del $pnam]
+ foreach lbs [wokBAG:cpnt:Patches $pnam] {
+ set res [concat $res [wokBAG:label:Del $lbs]]
+ }
+ padmin:execute $res $execute
+ }
+ return
+ }
+
+
+
+ if { [info exist tabarg(-ls)] } {
+ puts "not yet"
+ }
+
+
+ if { [info exist tabarg(-lsext)] } {
+ foreach e [wokBAG:magic:kex] {
+ puts $e
+ }
+ return
+ }
+
+ if { [info exist tabarg(-magic)] } {
+ foreach e [wokUtils:LIST:SortPurge [wokBAG:magic:Name]] {
+ puts "$e"
+ }
+ return
+ }
+
+
+
+}
+;#
+;#
+;#
+proc padmin:execute { res execute } {
+ if { $execute } {
+ wokUtils:FILES:ListToFile $res execute
+ wokUtils:EASY:Execute execute
+ unlink execute
+ } else {
+ foreach l $res {
+ puts "$l"
+ }
+ }
+}
+;#
+;# Je m'emmerddre , tai vi o phap troi lanh qua !!
+;#
+proc padmin:param { } {
+ set maxl 0
+ foreach name [wokBAG:bag:Names] {
+ set lb [$name 1]
+ if {[string length $lb] > $maxl} {
+ set maxl [string length $lb]
+ }
+ }
+ set maxl [expr {$maxl + 2}]
+ foreach name [wokBAG:bag:Names] {
+ puts stdout [format "%-*s %s" $maxl [$name 1] [$name]]
+ }
+ return
+}
--- /dev/null
+#############################################################################
+#
+# P I N T E G R E
+# _______________
+#
+#############################################################################
+#
+# Usage
+#
+proc pintegreUsage { } {
+ puts stderr \
+ {
+ usage : pintegre [ <reportID> ]
+
+ <reportID> is a number. The range of the report in the queue.
+ You get this number by using the command : pstore -ls
+
+ -all : Process all reports in the queue.
+ -noexec : Don't execute. Only display script file.
+ -dump <file> : Trace of commands in file. If file exists append commands.
+ }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc pintegre { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-all) {}
+ set tblreq(-v) {}
+ set tblreq(-noexec) {}
+ set tblreq(-dump) value_required:string
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq pintegreUsage $args] == -1 } return
+ set VERBOSE [info exists tabarg(-v)]
+
+ if { [info exists tabarg(-h)] } {
+ pintegreUsage
+ return
+ }
+
+ set fshop nil
+
+ if { [info exists tabarg(-all)] } {
+ set LISTREPORT [pstore:Report:Get all $fshop ]
+ } else {
+ if { [llength $param] == 1 } {
+ set ID [lindex $param 0]
+ set LISTREPORT [pstore:Report:Get $ID $fshop ]
+ } else {
+ pintegreUsage
+ return -1
+ }
+ }
+
+ set execute 1
+ if { [info exists tabarg(-noexec)] } { set execute 0 }
+
+ if { [info exists tabarg(-dump)] } {
+ set FileDump $tabarg(-dump)
+ }
+
+ set savpwd [pwd]
+
+ foreach REPORT $LISTREPORT {
+
+ if { [pstore:Report:Process $REPORT] != 1 } {
+ return
+ }
+ if { [set l [pstoreReportWasThere]] != {} } {
+ foreach f $l {
+ puts stderr "File $f has been removed since storage of that report."
+ }
+ pstore:Report:UnProcess $REPORT
+ return
+ }
+ pstoreReportHeader ReportHeader
+ pstoreReportBody ReportBody
+ set Config [pstoreReportConfig]
+ set pnam $ReportHeader(Parcel)
+ set label [wokBAG:cpnt:GetLabel $pnam]
+ set umaked [split $ReportHeader(Umaked) ,]
+ set tmpconf [lindex $Config 0]
+
+ set depends [wokBAG:cfg:Complete $tmpconf $umaked]
+
+ pstore:Report:UnProcess $REPORT
+
+ if { $VERBOSE } {
+ puts stderr "Processing report in $REPORT"
+ puts stderr "Will use label $label to stick elements of this update."
+ puts stderr "Requires $umaked"
+ puts stderr "That is: $depends"
+ }
+
+ set init $ReportHeader(Init) ;# Si Init != "NO" => level a creer et a updater si existe pas.
+
+ if { "$init" != "NO" } {
+ cd $ReportHeader(Revision)
+ set x_1 [wokBAG:cpnt:Init $pnam $ReportHeader(Revision) $ReportHeader(FrigoName)/cvt_data]
+ set x_2 [wokBAG:journal:Init $pnam $ReportHeader(Journal)]
+ set x_3 [wokBAG:label:Init $label]
+ set x_4 [wokBAG:hlink:Init $pnam]
+ set x_5 [wokBAG:label:Stick $label $ReportHeader(Master)]
+ set x_6 [wokBAG:label:Stick $label [wokBAG:journal:name $pnam]]
+ set res [concat $x_1 $x_2 $x_3 $x_4 $x_5 $x_6]
+ } else {
+ set x_mod {}
+ foreach e [array names ReportBody ##,*] {
+ set dir [file join $ReportHeader(Master) [string range $e 4 end]]
+ if { $ReportBody($e) != {} } {
+ set x_mod [concat $x_mod [wokBAG:cpnt:UpdateDirectory $dir $ReportBody($e)]]
+ }
+ }
+ set x_add {}
+ foreach e [lsort -command wokUtils:FILES:Depth [array names ReportBody ++,*]] {
+ set dir [file join $ReportHeader(Master) [string range $e 4 end]]
+ if { $ReportBody($e) != {} } {
+ set x_add [concat $x_add [wokBAG:cpnt:CreateDirectory $dir $ReportBody($e)]]
+ }
+ }
+ set x_del {}
+ foreach e [lsort -decreasing -command wokUtils:FILES:Depth [array names ReportBody --,*]] {
+ set dir [file join $ReportHeader(Master) [string range $e 4 end]]
+ if { $ReportBody($e) != {} } {
+ set x_del [concat $x_del [wokBAG:cpnt:DeleteDirectory $dir $ReportBody($e)]]
+ }
+ }
+ set x_labinit [wokBAG:label:Init $label]
+ set j_upd [wokBAG:journal:Update $pnam $ReportHeader(Journal)]
+ set x_lab [wokBAG:label:Stick $label $ReportHeader(Master)]
+ set j_lab [wokBAG:label:Stick $label [wokBAG:journal:name $pnam]]
+
+ set res [concat $x_mod $x_add $x_del $x_labinit $x_lab $j_upd $j_lab]
+
+ }
+
+ if { $depends != {} } {
+ set actdep [wokBAG:cfg:Complete $tmpconf $depends]
+ if { $actdep != {} } {
+ if { $VERBOSE } { puts stderr "Will link $label to $actdep" }
+ set res [concat $res [wokBAG:hlink:Attach $label $actdep]]
+ }
+ }
+
+ if { [info exists FileDump] } {
+ wokUtils:FILES:AppendListToFile $res $FileDump
+ }
+
+ wokUtils:FILES:ListToFile [wokUtils:EASY:stobs2 $res] $ReportHeader(COMMAND)_1
+ if { $execute } {
+ if { [set fileid [wokBAG:errlog:Add $pnam]] != {} } {
+ wokUtils:EASY:Execute $ReportHeader(COMMAND)_1 sh $fileid
+ close $fileid
+ } else {
+ puts "Unable to open log file for writing"
+ return
+ }
+ } else {
+ wokUtils:EASY:Execute $ReportHeader(COMMAND)_1 noexec stdout
+ }
+
+ ;# Mise a jour des levels
+
+ puts "Mise a jour levels Config = $Config"
+ foreach cfg $Config {
+ set LABELTMP $ReportHeader(LABEL).$cfg
+ wokUtils:FILES:ListToFile $label $LABELTMP
+ if { "$init" != "NO" } {
+ puts -nonewline "on fait INIT ($cfg) ..."
+ ;# Init = ANAME il faut soit creer le level soit l'updater avec la nouvelle UL.
+ set flevel [wokBAG:level:file $init $cfg]
+ if [file exists $flevel] {
+ puts "dans un level qui existe"
+ set contents [wokUtils:FILES:FileToList $flevel]
+ wokUtils:FILES:ListToFile [concat $contents $label] $LABELTMP
+ set xlv [wokBAG:level:update $flevel $LABELTMP]
+ } else {
+ puts "dans un level qui n'existe pas "
+ set xlv [wokBAG:level:Init $init $cfg $LABELTMP]
+ }
+ } else {
+ ;# Init = NO Il faut recuperer le level auquel appartient pnam
+ set lvl [wokBAG:level:find $label $cfg]
+ if { $lvl != {} } {
+ wokUtils:FILES:ListToFile [lindex $lvl 1] $LABELTMP
+ set xlv [wokBAG:level:update [lindex $lvl 0] $LABELTMP]
+ } else {
+ puts stderr "Error updating levels for $label in $cfg . Level not found"
+ return
+ }
+ }
+ wokUtils:FILES:ListToFile [wokUtils:EASY:stobs2 $xlv] $ReportHeader(COMMAND)_2
+ if { $execute } {
+ if { [set fileid [wokBAG:errlog:Add $pnam]] != {} } {
+ wokUtils:EASY:Execute $ReportHeader(COMMAND)_2 sh $fileid
+ close $fileid
+ } else {
+ puts "Unable to open log file for writing"
+ return
+ }
+ } else {
+ wokUtils:EASY:Execute $ReportHeader(COMMAND)_2 noexec stdout
+ }
+ }
+
+
+ ;# Destruction du report
+ if { $execute } { pstore:Report:Del $REPORT 1 }
+
+ }
+ cd $savpwd
+ return
+}
+
+#############################################################################
+#
+# P G E T
+# _______
+#
+#############################################################################
+#
+# Usage
+#
+proc pgetUsage { } {
+ puts stderr \
+ {
+ Usage : pget [-h] [-d dir] -conf <name> [-parcel <p1,p2,..>] [-P patch]
+ -h : this help
+ -d dir : Uses dir as directory for downloading files.
+ -conf name : configuration name. This parameter is required.
+ -parcel <p1,p2..> : list of one or more parcel. if this parameter is not given
+ install all parcels listed in name.
+ -v : verbose mode
+ -noexec : Display update operations but don't perform them.
+ [-P num ] : <num> is a patch number. By default the parcel is downloaded up to its last patch.
+ This option can be used to specify the higher patch level you want to download.
+ This option cannot be used with more than one parcel specified in the -parcel option.
+
+ Acces modes : By default, files of parcels are created (copied) in the bag of your factory. If you
+ specify -view <Myview> then a ClearCase view <Myview> will be configured so that
+ you can access (read) the parcels without copying them. Note that <Myview> must
+ already exists.
+ }
+}
+#
+# Point d'entree de la commande
+#
+proc pget { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-conf) value_required:string
+ set tblreq(-parcel) value_required:list
+ set tblreq(-d) value_required:string
+ set tblreq(-v) {}
+ set tblreq(-mode) value_required:string
+ set tblreq(-P) value_required:number
+ set tblreq(-cat) {}
+ set tblreq(-noexec) {}
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq pgetUsage $args] == -1 } return
+
+ if { $param != {} } {
+ pgetUsage
+ return
+ }
+
+
+ if { [info exists tabarg(-h)] } {
+ pgetUsage
+ return
+ }
+
+ set VERBOSE [info exists tabarg(-v)]
+
+ if { [info exists tabarg(-conf)] } {
+ set conf $tabarg(-conf)
+ } else {
+ pgetUsage
+ return
+ }
+
+ if { [info exists tabarg(-cat)] } {
+ foreach pnam [lsort [wokBAG:cfg:read $conf]] {
+ puts $pnam
+ }
+ return
+ }
+
+
+ if [info exists tabarg(-mode)] {
+ set mode $tabarg(-mode)
+ } else {
+ set mode copy
+ }
+
+ set view [wokBAG:view:GetViewExport]
+ ;# tester ici que la vue view existe
+
+ set fact [wokinfo -f [wokcd]]
+
+ if { [info exists tabarg(-d)] } {
+ set down $tabarg(-d)
+ if ![file exists $down] {
+ if { [wokUtils:DIR:create $down] == -1 } {
+ return
+ }
+ }
+ } else {
+ set down {}
+ }
+
+ if { [info exists tabarg(-parcel)] } {
+ set lnuk $tabarg(-parcel)
+ } else {
+ set luli [pget:ulist read $conf $fact $down {} $VERBOSE]
+ if { $luli != {} } {
+ set lnuk {}
+ foreach p $luli {
+ if { $p != {} } {
+ if { "[wokBAG:cpnt:parse extension $p]" == "$conf" } {
+ lappend lnuk [wokBAG:cpnt:parse root $p]
+ } else {
+ puts stderr "Mismatch version for $p . Ignored."
+ }
+ }
+ }
+ } else {
+ puts stderr "Please Specify at least one parcel of this config."
+ puts stderr "All parcels defined in this config are:"
+ pget -cat -conf $conf
+ return
+ }
+ }
+
+ if { [info exists tabarg(-P)] } {
+ if { [llength $lnuk] == 1 } {
+ set preq $tabarg(-P)
+ } else {
+ puts stderr "You cannot use -P option with more than one parcel."
+ return
+ }
+ }
+
+ if { $VERBOSE } { puts "lnuk = $lnuk" }
+ # lnuk est la liste des ULs demandees dans la ligne de commande
+ # wokBAG:cfg:read retourne la liste des Uls de <conf> au dernier niveau
+ # pget:sink fait la correspondance CCL <-> CCL-B4-5_13
+ # Il faudra mettre ici le niveau si il est demande et separer BASE, MODEL, APPLI
+
+ set linst [pget:sink $lnuk [wokBAG:cfg:read $conf {}]]
+ if { $linst == {} } {
+ puts "No match for $lnuk in config $conf."
+ return
+ }
+
+ # si preq est settee => il n'y a qu'une parcel , et on a demande une version precise.
+ # lcomp contient pour le level demandee la plus haute version connue.
+ # verifier que preq est inferieur ou egal a cette version.
+
+ if [info exists preq] {
+ set vx [wokBAG:cpnt:parse version $linst]
+ if { $preq > $vx } {
+ puts stderr "Patch level $preq does not exist. Higher level is $vx."
+ return
+ }
+ set lres [wokBAG:cpnt:parse basename $linst]_${preq}
+ } else {
+ set lres $linst
+ }
+
+ if { $VERBOSE } { puts "linst = $linst" }
+ ;# 1. Calcul du fichier ConfigSpec pour configurer la vue d'acces au Bag
+ ;#
+ wokBAG:cfg:ListToConfig $lres [set configspec [wokUtils:FILES:tmpname viewof[id user].setcs]]
+
+ if { $VERBOSE } {
+ foreach x [wokUtils:FILES:FileToList $configspec] { puts $x }
+ }
+
+ if { $VERBOSE } {
+ puts "Configuring view $view.."
+ }
+
+ ;# 2. execute ( config + demarrage )
+ ;#
+ set cfw [concat [wokBAG:view:setcs $configspec $view] [wokBAG:view:startview $view]]
+
+ ;# 3. La demarrer
+ ;#
+ wokUtils:FILES:ListToFile $cfw [set cmdget [wokUtils:FILES:tmpname cmdget[id user]]]
+ wokUtils:EASY:Execute $cmdget sh stdout
+
+ ;# 4. Mode increment, ou copy, ou view
+ ;#
+ switch -- $mode {
+
+ increment {
+ set lget {}
+ foreach pnam_x $lres {
+ set jnl [wokBAG:journal:read ${pnam_x}]
+ set dfrom [wokBAG:cpnt:GetExportName [wokBAG:cpnt:parse basename ${pnam_x}]]
+ set dto [pget:down $conf $fact $down $pnam_x]
+ if { $VERBOSE } { puts stderr "Downloading ${pnam_x} in $dto" }
+ set lget [concat $lget [pget:getfiles ${pnam_x} $jnl $dfrom $dto]]
+ }
+
+ ;# 5. Executer la copie
+ ;#
+ if { [info exists tabarg(-noexec)] } {
+ foreach x $lget {
+ puts "$x"
+ }
+ } else {
+ wokUtils:EASY:TclCommand $lget $VERBOSE
+ }
+
+ pget:ulist write $conf $fact $down $lres $VERBOSE
+ }
+
+ copy {
+ foreach pnam_x $lres {
+ set dfrom [wokBAG:cpnt:GetExportName [wokBAG:cpnt:parse basename ${pnam_x}]]
+ if { [file exist $dfrom] } {
+ set dto [pget:down $conf $fact $down ${pnam_x}]
+ if { $VERBOSE } { puts stderr "Downloading ${pnam_x} in $dto" }
+ set FunCopy wokUtils:FILES:copy
+ if { [info exists tabarg(-noexec)] } { set FunCopy pget:CopyNothing }
+ wokUtils:FILES:recopy $dfrom $dto $VERBOSE $FunCopy
+ } else {
+ puts stderr "Error: Directory $dfrom is unreachable."
+ }
+ }
+
+ pget:ulist write $conf $fact $down $lres $VERBOSE
+ }
+
+ view {
+ }
+
+ }
+
+ return
+}
+#
+# retourne le nom du dir ou il faut descendre pnam_x
+#
+proc pget:down { conf fact down pnam_x } {
+ if { $down == {} } {
+ set root [wokinfo -p HomeDir ${fact}:[finfo -W $fact]]
+ return $root/[wokBAG:cpnt:parse root ${pnam_x}]-${conf}
+ } else {
+ return $down
+ }
+}
+#
+# Lit/Ecrit la liste des Uls du bag de <fact> se trouvant listes dans <conf>.
+# De fait le contenu de : Factory/adm/K4E_Config.
+# ya qqche dans WOK pour lire mais pas pour ecrire
+# quand on fait read: ulist = {} retourne dans la liste le contenu du parametre K4E_Config
+# quand on fait write ulist = suite de pnam_x retourne une liste ayant le format suivant
+# {KERNEL KERNEL-K4E down KERNEL-B4-2 8}
+#
+proc pget:ulist { option conf fact down ulist VERBOSE } {
+ switch -- $option {
+
+ read {
+ set lvc [wokparam -l ${conf} $fact]
+ if { $lvc != {} } {
+ if { [lsearch -regexp $lvc %${conf}_Config=*] != -1 } {
+ catch { set value [wokparam -e %${conf}_Config $fact] }
+ if [info exists value] {
+ return [split [join $value]]
+ } else {
+ return {}
+ }
+ } else {
+ return {}
+ }
+ } else {
+ return {}
+ }
+ }
+
+ write {
+ set bagName ${fact}:[finfo -W $fact]
+ set bagAdm [wokinfo -p AdmDir $bagName]
+ set ParcelListFile [wokinfo -p ParcelListFile $bagName]
+ set lp [wokUtils:FILES:FileToList $ParcelListFile]
+ set Config "@set %${conf}_Config = \""
+ set Runtime "@set %${conf}_Runtime = \""
+ foreach pnam_x $ulist {
+ set pclName [wokBAG:cpnt:parse root ${pnam_x}]
+ set pclHome [pget:down $conf $fact $down ${pnam_x}]
+ set pclAdm $pclHome/adm
+ catch { mkdir -path $pclAdm }
+ set edl [pget:declare ${pclName}-${conf} $pclName $pclHome $pclAdm]
+ if [wokUtils:FILES:ListToFile [list $edl] $bagAdm/${pclName}-${conf}.edl] {
+ if { $VERBOSE } { puts stderr "File $bagAdm/${pclName}-${conf}.edl has been created." }
+ } else {
+ puts stderr "Unable to create file $bagAdm/${pclName}-${conf}.edl"
+ }
+ pget:WVersion $bagName $conf ${pclName} ${pnam_x}
+ ;#if [wokUtils:FILES:ListToFile ${pnam_x} $pclAdm/${pclName}.version] {
+ ;#if { $VERBOSE } { puts stderr "File $pclAdm/${pclName}.version has been created" }
+ ;#} else {
+ ;# puts stderr "Unable to create file $pclAdm/${pclName}.version"
+ ;#}
+ append Config " ${pclName}-${conf}"
+ if { [lsearch $lp ${pclName}-${conf}] == -1 } { lappend lp ${pclName}-${conf} }
+ }
+ append Config "\";"
+ append Runtime "\";"
+ if [wokUtils:FILES:ListToFile [list $Config $Runtime] [wokinfo -p AdmDir $fact]/${conf}.edl] {
+ if { $VERBOSE } { puts stderr "File [wokinfo -p AdmDir $fact]/${conf}.edl has been updated" }
+ } else {
+ puts stderr "Unable to update file [wokinfo -p AdmDir $fact]/${conf}.edl"
+ }
+ if [wokUtils:FILES:ListToFile $lp $ParcelListFile] {
+ if { $VERBOSE } { puts stderr "File $ParcelListFile has been updated."}
+ } else {
+ puts stderr "Unable to update file $ParcelListFile."
+ }
+ }
+ }
+
+}
+#
+# retourne les occurences de lnuk = { CCL GRAPHIC KERNEL VIEWERS .. }
+# trouvees dans loff = { KERNEL-B4-2_x CCL-B4-2_y GRAPHIC-B4-2_z ...}
+#
+proc pget:sink { lnuk loff } {
+ foreach p $loff {
+ set map([wokBAG:cpnt:parse root $p]) $p
+ }
+ set l {}
+ foreach p $lnuk {
+ if [info exists map($p)] {
+ lappend l $map($p)
+ } else {
+ puts stderr "Warning : $p not found in required config. Ignored"
+ }
+ }
+ return $l
+}
+;#
+;# retourne la liste des commandes a passer pour updater le directory dest avec le patch pnam_x
+;# La vue doit avoir ete configuree (element * pnam_x -nocheckout)
+;#
+proc pget:getfiles { pnam_x jnl dmas dest } {
+ if ![ catch { set fileid [ open $jnl r ] } ] {
+ pprepare:header:read $fileid RepHeader
+ wokUtils:EASY:ReadCompare ReportBody $fileid
+ if ![wokUtils:EASY:MapEmpty ReportBody] {
+ set x_mod {}
+ set vers ${pnam_x}
+ foreach e [array names ReportBody ##,*] {
+ set dir [string range $e 4 end]
+ if { $ReportBody($e) != {} } {
+ set x_mod [concat $x_mod [pget:UpdateDirectory $vers $dest $dmas $dir $ReportBody($e)]]
+ }
+ }
+
+ set x_add {}
+ foreach e [lsort -command wokUtils:FILES:Depth [array names ReportBody ++,*]] {
+ set dir [string range $e 4 end]
+ if { $ReportBody($e) != {} } {
+ set x_add [concat $x_add [pget:CreateDirectory $vers $dest $dmas $dir $ReportBody($e)]]
+ }
+ }
+
+ set x_del {}
+ foreach e [lsort -decreasing -command wokUtils:FILES:Depth [array names ReportBody --,*]] {
+ set dir [string range $e 4 end]
+ if { $ReportBody($e) != {} } {
+ set x_del [concat $x_del [pget:DeleteDirectory $vers $dest $dmas $dir $ReportBody($e)]]
+ }
+ }
+
+ }
+ close $fileid
+ return [concat $x_mod $x_add $x_del]
+ } else {
+ puts stderr "pget:getfiles. Unable to open $jnl for reading."
+ return {}
+ }
+}
+;#
+;#
+;#
+proc pget:UpdateDirectory { vers dest dmas dir lfile } {
+ set l {}
+ foreach e $lfile {
+ if [regexp { #[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem from] {
+ lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]"
+ } elseif [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] {
+ lappend l "wokUtils:FILES:delete [file join $dest $dir $basn]"
+ } elseif [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] {
+ lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]"
+ } else {
+ puts stderr "pget:UpdateDirectory: Line $e does not match anything !!"
+ return {}
+ }
+ }
+ return $l
+}
+;#
+;#
+;#
+proc pget:CreateDirectory { vers dest dmas dir lfile } {
+ lappend l "wokUtils:DIR:create [file join $dest $dir]"
+ foreach e $lfile {
+ if [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] {
+ if [file exists [file join $dmas $dir $basn]@@/main/$vers] {
+ lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]"
+ } else {
+ puts stderr "pget:CreateDirectory: [file join $dmas $dir $basn]@@/main/$vers not found"
+ }
+ } else {
+ puts stderr "pget:CreateDirectory: Line $e does not match anything !!"
+ return {}
+ }
+ }
+ return $l
+}
+;#
+;# Removes all files in dir but dont removes directory itself. Merdier aggregats
+;#
+proc pget:DeleteDirectory { vers dest dmas dir lfile } {
+ foreach e $lfile {
+ if [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] {
+ lappend l "wokUtils:FILES:delete [file join $dest $dir $basn]"
+ }
+ }
+ ;#lappend l "rmdir [file join $dest $dir]"
+ return $l
+}
+;#
+;# Remplace Wdeclare..
+;# 1. ce qui est retourne doit etre ecrit dans CCL-K4E.edl dans l'adm du bag et s'appeler CCL-K4E.edl.
+;# Wdeclare -p ${pclName}-${conf} -d -DHome=$pclHome -DDelivery=$pclName $bagName
+;#
+;# p = CCL-K4E
+;# d = CCL
+;# h = /adv_22/WOK/BAG/CCL-K4E
+;# a = /adv_22/WOK/BAG/CCL-K4E/adm
+;#
+proc pget:declare { p d h a } {
+ append st {@ifnotdefined ( %__PNAM_EDL ) then} \n
+ append st {@set %__PNAM_EDL = "";} \n
+ append st {@set %__PNAM_Home = "__HOME";} \n
+ append st {@set %__PNAM_Adm = "__ADM";} \n
+ append st {@set %__PNAM_Stations = "sun ao1 sil hp";} \n
+ append st {@set %__PNAM_DBMSystems = " DFLT ";} \n
+ append st {@set %__PNAM_Delivery = "__NAME";} \n
+ append st {@ifdefined(%ShopName) then} \n
+ append st {@uses "USECONFIG.edl";} \n
+ append st {@endif;} \n
+ append st {@endif;} \n
+ regsub -all {__PNAM} $st $p r1
+ regsub -all {__NAME} $r1 $d r2
+ regsub -all {__HOME} $r2 $h r3
+ regsub -all {__ADM} $r3 $a xx
+ return $xx
+}
+;#
+;# Retourne le nom de l'UL
+;#
+proc pget:RVersion { bagName conf PclName } {
+ if [wokinfo -x ${bagName}:${PclName}-${conf}] {
+ set pclAdm [wokinfo -p admdir ${bagName}:${PclName}-${conf}]/${PclName}.version
+ return [wokUtils:FILES:FileToList $pclAdm]
+ } else {
+ return {}
+ }
+}
+;#
+;#
+;#
+proc pget:WVersion { bagName conf PclName version } {
+ set pclAdm [wokinfo -p admdir ${bagName}:${PclName}-${conf}]/${PclName}.version
+ return [wokUtils:FILES:ListToFile $version $pclAdm]
+}
+;#
+;#
+;#
+proc pget:specialwok { } {
+}
+;#
+;# copy avec -noexec mode.
+;#
+proc pget:CopyNothing { f1 f2 } {
+ puts stderr "copy $f1 $f2"
+ return
+}
--- /dev/null
+#############################################################################
+#
+# P N E W S
+# _________
+#
+#############################################################################
+#
+# Usage
+#
+proc wokpnewsUsage { } {
+ puts stderr \
+ {
+ Usage : pnews [-h] [-parcel <p1,p2,..>]
+
+ }
+}
+#
+# Point d'entree de la commande
+#
+proc pnews { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-parcel) value_required:string
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokpnewsUsage $args] == -1 } return
+
+
+ if { [info exists tabarg(-h)] } {
+ wokpnewsUsage
+ return
+ }
+
+ set VERBOSE [info exists tabarg(-v)]
+
+ if { [info exists tabarg(-parcel)] } {
+ pnews:journal $tabarg(-parcel)
+ return
+ }
+
+ return
+}
+#
+# Retourne la liste des Uls du bag de <factory> se trouvant listes dans <config>
+#
+proc pnews:journal { {regx *} } {
+ wokBAG:label:dump JNL long
+ set blank " "
+ if [array exists JNL] {
+ set i 0
+ foreach n [lsort -command wokUtils:TIME:clrsort [array names JNL]] {
+ set i [incr i]
+ set pnam [lindex [split $JNL($n)] 0]
+ if [string match $regx $pnam] {
+ set b [string range $blank 1 [expr {30 - [string length $pnam] }]]
+ puts [format "%3d - %s%s (Done at %s)" $i $pnam $b $n ]
+ }
+ }
+ }
+ return
+}
--- /dev/null
+#############################################################################
+#
+# P P R E P A R E
+# _______________
+#
+#############################################################################
+#
+# Usage
+#
+proc wokpprepareUsage { } {
+ puts stderr \
+ {
+ Usage: pprepare Pnam [ options... ]
+
+ Compare the parcel Pnam in the local bag with its last occurence in
+ the reference bag. Pnam should be given with its full path, in the format
+ FACTORY:BAGNAME:PARCELNAME
+
+ File extensions in Pnam are checked against a list of known types.
+ If some extensions are unknown, a warning is issued.
+
+ Options for specifying location and contents of the parcel Pnam.
+ -from <dir> specify that <dir> must be used as the contents of Pnam.
+ By default <dir> is the root directory of the parcel in the bag of
+ your factory.
+
+ -init <level> specify that Pnam is a new parcel to be initialized in the
+ reference BAG. No comparison is done. <level> is a character string
+ that identify the level the parcel belongs to. <level> should be
+ given using uppercase letter.
+
+ -req specify a list of parcels used to build Pnam.
+ By default this list is automatically inserted using the requisites
+ declared in your bag.
+
+ Options for specifying output.
+
+ By default, creates a file named Pnam.report in the current directory.
+ If option -o <file> is specified the output is written in file.
+ By default the identical files are not listed unless option -show= is
+ specified.
+
+ Options for filtering comparison:
+
+ By default, all the directories and files under Pnam root directory
+ are compared with the contents of the last occurence of pnam in
+ the reference bag. You can avoid some of these comparisons with the
+ following options.
+
+ -depth depth : Subdirectories whose level is greater than depth are
+ not compared. (Directory itself is depth = 0 )
+ -ext e1,e2,..: Select extension file to be compared. Extenstions must
+ separated by comma, and begin with a dot (.)
+ -dir d1,d2,. : Select directory names to be compared. Names can be
+ glob-style match.
+ -Xdir d1,d2, : Same as above but excludes listed directories.
+
+ Examples:
+
+ Writes in /tmp/report the compared state of parcel KL:BAG:KERNEL-B4-1
+ with the last occurence of KERNEL-B4-1 in the reference BAG.
+
+ tclsh> pprepare KL:BAG:KERNEL-B4-1 -o /tmp/report
+
+ }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc pprepare { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-o) value_required:file
+ set tblreq(-show=) {}
+ set tblreq(-init) value_required:string
+ set tblreq(-from) value_required:file
+ set tblreq(-v) {}
+ set tblreq(-V) {}
+ set tblreq(-req) value_required:string
+ set tblreq(-depth) value_required:string
+ set tblreq(-ext) value_required:list
+ set tblreq(-dir) value_required:list
+ set tblreq(-xdir) value_required:list
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokpprepareUsage $args] == -1 } return
+
+ if [info exists tabarg(-h)] {
+ wokpprepareUsage
+ return
+ }
+
+ set verbose 0
+ if { [info exists tabarg(-v)] || [info exists tabarg(-V)] } { set verbose 1 }
+
+ if { [llength $param] != 1 } {
+ wokpprepareUsage
+ return
+ }
+
+ set hidee 1
+ if [info exists tabarg(-show=)] {
+ set hidee 0
+ }
+
+
+ set init NO
+ if [info exists tabarg(-init)] {
+ set init $tabarg(-init)
+ }
+
+ if { [set comp [package require Wokutils]] != {} } {
+ set compare_routine wokcmp
+ } else {
+ set compare_routine wokUtils:FILES:AreSame
+ }
+
+ if { $verbose } { puts "Will use the command $compare_routine for file comparison." ; flush stdout }
+
+ set inam [lindex $param 0]
+
+ if [info exists tabarg(-from)] {
+ set pnam $inam ;# si il n'y a pas de :
+ set drev $tabarg(-from)
+ } else {
+ if [wokinfo -x $inam] {
+ set pnam [wokinfo -n $inam]
+ set drev [wokinfo -p HomeDir $inam]
+ } else {
+ puts "Qui peut me dire comment on utilise simplement wokinfo et Cie.. ??"
+ puts "En attendant specifier la parcel avec son full path. Ex KERNEL:BAG:KERNEL-B6-1"
+ puts "ou utiliser l'option -from pour dire ou faut prendre les directories de l'UL"
+ return
+ }
+ }
+
+ if [info exists tabarg(-req)] {
+ set umak $tabarg(-req)
+ } else {
+ set umak [pprepare:depends:read $inam]
+ }
+
+ set dmas [wokBAG:cpnt:GetImportName $pnam]
+ if { "$init" == "NO" } {
+ if { $verbose } { puts "Will use $dmas as directory for comparison" ; flush stdout }
+ if { [file exists $dmas] } {
+ if { ![file isdirectory $dmas] } {
+ puts stderr "$dmas is not a directory"
+ return
+ }
+ if { $verbose } { puts -nonewline "Reading $dmas ..."; flush stdout }
+
+ wokUtils:FILES:DirToMap $dmas mas
+
+ if { $verbose } { puts "Done" ; flush stdout}
+ if [info exists mas(/lost+found)] {
+ unset mas(/lost+found)
+ }
+ }
+ }
+
+ if { [file exists $drev] } {
+ if { ![file isdirectory $drev] } {
+ puts stderr "$drev is not a directory"
+ return
+ }
+ if { $verbose } { puts -nonewline "Reading $drev ..." ; flush stdout }
+ wokUtils:FILES:DirToMap $drev rev
+ if { $verbose } { puts "Done" ; flush stdout }
+ if [info exists rev(/lost+found)] {
+ unset rev(/lost+found)
+ }
+ } else {
+ puts stderr "Directory $drev does not exists."
+ return
+ }
+
+ if [info exists tabarg(-o)] {
+ if [ catch { set fileid [ open [set written $tabarg(-o)] w ] } status ] {
+ puts stderr "$status"
+ return
+ }
+ } else {
+ if [ catch { set fileid [ open [set written [pwd]/${pnam}.report] w ] } status ] {
+ puts stderr "$status"
+ return
+ }
+ }
+
+ set gblist {}
+ if [info exists tabarg(-ext)] {
+ foreach e $tabarg(-ext) {
+ lappend gblist $e
+ }
+ }
+
+ if [info exists tabarg(-depth)] {
+ set depth [expr $tabarg(-depth) + 1]
+ if [array exists mas] {
+ foreach ky [array names mas] {
+ if { [expr [llength [split $ky /]] -1] >= $depth } {
+ unset mas($ky)
+ }
+ }
+ }
+ foreach ky [array names rev] {
+ if { [expr [llength [split $ky /]] -1] >= $depth } {
+ unset rev($ky)
+ }
+ }
+ }
+
+ if [info exists tabarg(-dir)] {
+ foreach ptn $tabarg(-dir) {
+ if [array exists mas] {
+ foreach ky [array names mas] {
+ if ![string match $ptn $ky] {
+ unset mas($ky)
+ }
+ }
+ }
+ foreach ky [array names rev] {
+ if ![string match $ptn $ky] {
+ unset rev($ky)
+ }
+ }
+ }
+ }
+
+ if [info exists tabarg(-xdir)] {
+ foreach ptn $tabarg(-xdir) {
+ if [array exists mas] {
+ foreach ky [array names mas] {
+ if [string match $ptn $ky] {
+ unset mas($ky)
+ }
+ }
+ }
+ foreach ky [array names rev] {
+ if [string match $ptn $ky] {
+ unset rev($ky)
+ }
+ }
+ }
+ }
+ ;# bai gio em phai di lam...
+ if { $verbose } { puts -nonewline "Begin comparison ..." ; flush stdout }
+ wokUtils:EASY:Compare mas rev MAPWRK $compare_routine $hidee $gblist
+ if { $verbose } { puts "Done ..." ; flush stdout }
+
+ pprepare:header:write $pnam $dmas $drev $init $umak $fileid
+ wokUtils:EASY:WriteCompare $dmas $drev MAPWRK $fileid
+ pprepare:comments:write $fileid
+
+ if { [string match file* $fileid] } {
+ close $fileid
+ }
+
+ set l [wokUtils:EASY:RevFiles MAPWRK]
+ wokUtils:EASY:ext $l Extensions
+ if { [set unk [wokBAG:magic:CheckExt [array names Extensions]]] != {} } {
+ foreach ext $unk {
+ puts "Error : Unknown extension $ext"
+ }
+ }
+
+ puts "File $written has been created."
+ return
+}
+;#
+;# retourne le header d'un report dans map.
+;#
+proc pprepare:header:read { fileid map } {
+ upvar $map TLOC
+ while {[gets $fileid x] >= 0} {
+ if { [regexp {^Parcel : (.*)} $x all pnam] } {set f0 1 }
+ if { [regexp {^Master : (.*)} $x all dmas] } {set f1 1 }
+ if { [regexp {^Revision: (.*)} $x all drev] } {set f2 1 }
+ if { [regexp {^Init : (.*)} $x all init] } {set f3 1 }
+ if { [regexp {^Umaked : (.*)} $x all umak] } {set f4 1 }
+ if { [info exists f0] && [info exists f1] && [info exists f2] && [info exists f3] && [info exists f4]} {
+ array set TLOC [list Parcel $pnam Master $dmas Revision $drev Init $init Umaked $umak]
+ return 1
+ }
+ }
+ return {}
+}
+;#
+;# ecrit le header d'un report.
+;#
+proc pprepare:header:write { pnam dir1 dir2 init umak fileid } {
+ puts $fileid "Parcel : $pnam"
+ puts $fileid "Master : $dir1"
+ puts $fileid "Revision: $dir2"
+ puts $fileid "Init : $init"
+ puts $fileid "Umaked : $umak"
+ return
+}
+;#
+;# retourne les commentaires d'un report
+;#
+proc pprepare:comments:read { fileid } {
+ set l {}
+ while {[gets $fileid x] >= 0} {
+ lappend l $x
+ }
+ return $l
+}
+;#
+;# ecrit un template de commentaires d'un report
+;#
+proc pprepare:comments:write { fileid } {
+ puts $fileid "is"
+ puts $fileid " Author :"
+ puts $fileid " Study/CSR :"
+ puts $fileid " Debug :"
+ puts $fileid " Improvements :"
+ puts $fileid " News :"
+ puts $fileid " Deletions :"
+ puts $fileid " Impact :"
+ puts $fileid " Comments :"
+ puts $fileid "end;"
+}
+;#
+;# recupere les dependances de fab i. e. lit un machin ecrit
+;# /adv_20/MDL/BAG/GEOMETRY-M4-6/adm/GEOMETRY.depul qui contient (GEOMLITE-M4-6 KERNEL-K4L)
+;#
+;# inam est un FULL PATH.
+;#
+proc pprepare:depends:read { inam } {
+ if [wokinfo -x $inam] {
+ set nam [wokBAG:cpnt:parse root [wokinfo -n $inam]]
+ return [wokUtils:FILES:FileToList [wokinfo -p AdmDir $inam]/$nam.depul]
+ }
+}
--- /dev/null
+
+#############################################################################
+#
+# P S T O R E
+# ___________
+#
+#############################################################################
+#
+# Usage
+#
+proc pstoreUsage { } {
+ puts stderr \
+ {
+ Usage : pstore [-conf cnam1,cnam2,..] [-f] [-rm|-ls|-cat] [filename]
+
+ pstore filename -conf option : Add a report in the report's list from <filename>.
+ -conf option is mandatory. : Will update <cnam1,cnam2> during integration. (pintegre)
+
+ pstore [-ls] : Lists pending reports with their owner and IDs.
+ pstore -cat <report_ID> : Shows the content of <report_ID>.
+ pstore [-f] -rm <report_ID>: Remove a report from the queue
+ : (-f used to force if you dont own the report).
+
+ -dump <report_ID> : Dump contents of Report .
+ -check : Check that all files referenced in queue have not
+ not been modified since their storage.
+
+ }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc pstore { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-f) {}
+ set tblreq(-rm) {}
+ set tblreq(-ls) {}
+ set tblreq(-cat) {}
+
+ set tblreq(-dump) {}
+ set tblreq(-check) {}
+
+ set tblreq(-conf) value_required:list
+
+
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq pstoreUsage $args] == -1 } return
+
+ set option_specified [array exists tabarg]
+
+ if { [info exists tabarg(-h)] } {
+ pstoreUsage
+ return
+ }
+
+ if { [info exists tabarg(-f)] } {
+ set forced -1
+ } else {
+ set forced 0
+ }
+
+
+
+ set fshop nil
+
+ set FrigoName [pstore:Report:MkRoot $fshop 1]
+
+ if { $FrigoName == {} } {
+ msgprint -c WOKBAG -e "Bad queue name."
+ return
+ }
+
+ set ListReport [pstore:Report:GetReportList $FrigoName]
+
+ ;#
+ ;# Options ne s'appliquant pas a un ID
+ ;#
+ set ID [lindex $param 0]
+
+ if { $ID == {} } {
+ if { ( [info exists tabarg(-ls)] == 1 ) || ( $option_specified == 0 ) } {
+ set i 0
+ foreach e $ListReport {
+ set user [wokUtils:FILES:Userid $FrigoName/$e]
+ set str [pstore:Report:GetPrettyName $e]
+ if { $str != {} } {
+ set rep [string range [lindex $str 0] 0 19]
+ set dte [lindex $str 1]
+ puts [format "%3d - %-10s %-20s (stored at %s)" [incr i] $user $rep $dte ]
+ } else {
+ msgprint -c WOKBAG -e "Bad entry ($e) found in report.list"
+ }
+ }
+ return
+ } elseif { [info exists tabarg(-check)] } {
+ set LISTREPORT [pstore:Report:Get all $fshop]
+ foreach REPORT $LISTREPORT {
+ set cmd [pstore:Report:Process $REPORT]
+ if { [info procs pstoreReportWasThere] != {} } {
+ if { [set l [pstoreReportWasThere]] != {} } {
+ foreach f $l {
+ puts stderr "File $f has been removed since storage of that report."
+ }
+ return
+ }
+ }
+ if { [info procs pstoreReportRemember] != {} } {
+ if { [set l [pstoreReportRemember]] != {} } {
+ foreach [list fn dt] $l {
+ puts -nonewline stderr "File date has changed for $fn."
+ puts stderr "Was stored at [fmtclock $dt]. Current is [fmtclock [file mtime $fn]]"
+ }
+ }
+ }
+ pstore:Report:UnProcess $REPORT
+ }
+ return
+ }
+ }
+
+ if { [info exists tabarg(-check)] || [info exists tabarg(-ls)] } {
+ pstoreUsage
+ return
+ }
+
+
+ ;#
+ ;# Options s'appliquant a un ID
+ ;#
+
+ if ![wokUtils:FILES:ValidName $ID] {
+ msgprint -c WOKBAG -e "Malformed command or invalid file name $ID"
+ return {}
+ }
+
+
+
+ if [info exists tabarg(-rm)] {
+ set entry [pstore:Report:GetTrueName $ID $ListReport]
+ if { $entry != {} } {
+ pstore:Report:Del $FrigoName/$entry $forced
+ }
+ return
+ }
+
+ if [info exists tabarg(-cat)] {
+ set entry [pstore:Report:GetTrueName $ID $ListReport]
+ if { $entry != {} } {
+ set rep $FrigoName/$entry/report-orig
+ if { [file exists $rep] } {
+ return [exec cat $rep]
+ } else {
+ msgprint -c WOKBAG -e "File $rep not found."
+ }
+ }
+ return
+ }
+
+ if [info exists tabarg(-dump)] {
+ set entry [pstore:Report:GetTrueName $ID [pstore:Report:GetReportList $FrigoName]]
+ return [pstore:Report:Dump $FrigoName/$entry]
+ }
+
+
+ if { [info exists tabarg(-conf)] } {
+ set Config $tabarg(-conf)
+ } else {
+ pstoreUsage
+ return
+ }
+
+ if [file exists [set report [lindex $ID 0]]] {
+ if ![ catch { set fileid [ open $report r ] } ] {
+ pprepare:header:read $fileid RepHeader
+ set pnam $RepHeader(Parcel)
+ if ![pstore:Report:Exists $pnam $ListReport] {
+ wokUtils:EASY:ReadCompare map $fileid
+ if ![wokUtils:EASY:MapEmpty map] {
+ set entry [pstore:Report:GetUniqueName $pnam]
+ if { $entry != {} } {
+ if [pstore:Report:Add $Config $report RepHeader map $FrigoName/${entry}] {
+ msgprint -c WOKBAG -i [set subject "Report $report has been stored."]
+ seek $fileid 0 start
+ pstore:mail:Send "With love from $pnam ..." [read $fileid]
+ close $fileid
+ } else {
+ msgprint -c WOKBAG -e " during storage of $report"
+ catch { exec rm -rf $FrigoName/${entry} }
+ }
+ } else {
+ msgprint -c WOKBAG -e "Parcel name $pnam should not contains a comma."
+ }
+ } else {
+ msgprint -c WOKBAG -e "Report $report is empty."
+ }
+ } else {
+ msgprint -c WOKBAG -e "A report for parcel $pnam is already in queue."
+ }
+ } else {
+ msgprint -c WOKBAG -e "File $report cannot be read."
+ }
+ } else {
+ msgprint -c WOKBAG -e "File $report not found."
+ }
+ return
+}
+#;>
+# Ajoute un report dans un frigo
+#;<
+proc pstore:Report:Add { Config report Header table frigo } {
+ upvar $Header RepHeader $table RepBody
+
+ mkdir -path $frigo
+ chmod 0777 $frigo
+
+ set RepHeader(FrigoName) $frigo
+ wokUtils:FILES:ListToFile {} [set RepHeader(COMMAND) $frigo/COMMAND]
+ wokUtils:FILES:ListToFile {} [set RepHeader(LABEL) $frigo/LABEL]
+ wokUtils:FILES:copy $report [set RepHeader(Journal) $frigo/report-orig]
+ wokUtils:EASY:ListToProc $Config $frigo/Config.tcl pstoreReportConfig
+ wokUtils:EASY:MapToProc RepHeader $frigo/Header.tcl pstoreReportHeader
+ wokUtils:EASY:MapToProc RepBody $frigo/Body.tcl pstoreReportBody
+ set l [wokUtils:EASY:RevFiles RepBody]
+ wokUtils:FILES:ListToFile [wokUtils:FILES:WasThere $l pstoreReportWasThere] $frigo/WasThere.tcl
+ source $frigo/WasThere.tcl
+ if { [set ll [pstoreReportWasThere]] == {} } {
+ wokUtils:FILES:ListToFile [wokUtils:FILES:Remember $l pstoreReportRemember] $frigo/Remember.tcl
+ chmod 0777 [list $frigo/Config.tcl $frigo/Header.tcl $frigo/Body.tcl $frigo/Remember.tcl $frigo/report-orig $frigo/COMMAND $frigo/LABEL]
+ rename pstoreReportWasThere {}
+ wokUtils:EASY:ext $l Extensions
+ if { [set unk [wokBAG:magic:CheckExt [array names Extensions]]] != {} } {
+ foreach ext $unk {
+ puts "Error : Unknown extension $ext ( $Extensions($ext) )"
+ }
+ return 0
+ }
+ return 1
+ } else {
+ foreach f $ll {
+ puts stderr "File $f not found"
+ }
+ rename pstoreReportWasThere {}
+ return 0
+ }
+}
+#;>
+# Lit un report enregistre par pstore, remplit une table
+#;<
+proc pstore:Report:Process { RepName } {
+ foreach file [list Config.tcl WasThere.tcl Remember.tcl Header.tcl Body.tcl] {
+ if { [file exists $RepName/$file] } {
+ source $RepName/$file
+ } else {
+ puts stderr "Report:Process. File $file not found in $RepName."
+ return 0
+ }
+ }
+ return 1
+}
+#;>
+# retire les procs utilisees par un report
+# Pour l'instant RepName n'est pas utilise (la proc est independante !!).
+#;<
+proc pstore:Report:UnProcess { RepName } {
+ foreach proc [list pstoreReportConfig pstoreReportWasThere pstoreReportRemember pstoreReportHeader pstoreReportBody] {
+ if { [info procs $proc] != {} } {
+ rename $proc {}
+ }
+ }
+}
+#;>
+# Retire un report du frigo, le report est donne par son full path
+#;<
+proc pstore:Report:Del { LISTREPORT {forced -1} } {
+ foreach entry $LISTREPORT {
+ if { [file owned $entry] || $forced != -1 } {
+ if { [pstore:Report:RmEntry $entry] == -1 } {
+ return -1
+ }
+ } else {
+ msgprint -c WOKBAG -e "You are not the owner of this report."
+ return -1
+ }
+ }
+ return
+}
+#;>
+# Detruit effectivement une entry (full path) dans la queue.
+#;<
+proc pstore:Report:RmEntry { fullentry } {
+ foreach itm [glob -nocomplain $fullentry/*] {
+ if [file isdirectory $itm] {
+ wokUtils:FILES:removedir $itm
+ }
+ }
+ wokUtils:FILES:removedir $fullentry
+ return
+}
+;#
+;#
+;#
+proc pstore:Report:Getexcep { } {
+ return [list LABEL COMMAND Remember.tcl Header.tcl Body.tcl cvt_data report-orig]
+}
+
+#;>
+# Pour debugger. Imprime tout ce qui se trouve accroche sous ID
+#;<
+proc pstore:Report:Dump { D } {
+ wokUtils:FILES:FindFile $D *
+}
+#;>
+# Retourne le nom de l'entry associee a ReportID {} sinon
+#;<
+proc pstore:Report:GetTrueName { ReportID listreport } {
+ set ln [llength $listreport]
+ if { $ln > 0 } {
+ if [ regexp {^[0-9]+$} $ReportID ] {
+ set idm1 [expr $ReportID - 1]
+ set res [lindex $listreport $idm1]
+ if { $res != {} } {
+ return $res
+ } else {
+ msgprint -c WOKBAG -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) "
+ return {}
+ }
+ } else {
+ msgprint -c WOKBAG -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) "
+ return {}
+ }
+ } else {
+ msgprint -c WOKBAG -e "Report Queue is empty."
+ return {}
+
+ }
+}
+#;>
+#
+# Retourne un nom de directory unique base sur l'heure /append le nom du report
+#
+#;<
+proc pstore:Report:GetUniqueName { name } {
+ if { [string first , $name] == -1 } {
+ return [getclock],${name}
+ } else {
+ return {}
+ }
+}
+#;>
+# A partir d'un nom genere par GetUniqueName, retourne une liste de 2 elem
+# 1. La date ayant servi a creer le directory
+# 2. Le nom du report
+#;<
+proc pstore:Report:GetPrettyName { Uniquename } {
+ set l [split $Uniquename ,]
+ return [list [lindex $l 1] [fmtclock [lindex $l 0]] ]
+}
+;#
+;# Retourne 1 si pnam est deja dans la liste des reports.
+;#
+proc pstore:Report:Exists { pnam ListReport } {
+ if { [lsearch -glob $ListReport *,$pnam] == -1 } {
+ return 0
+ } else {
+ return 1
+ }
+}
+#;>
+# Retourne la liste des reports ordonnee par rapport a leur date d'arrivee
+#;<
+proc pstore:Report:GetReportList { FrigoName } {
+ if [file exists $FrigoName] {
+ return [lsort -command pstore:Report:SortEntry [readdir $FrigoName] ]
+ } else {
+ return {}
+ }
+}
+#;>
+# Retourne l'index dans la queue d'un report -1 si existe pas
+#;<
+proc pstore:Report:Index { FrigoName Truename } {
+ set i [lsearch [pstore:Report:GetReportList $FrigoName] $Truename]
+ if { $i != -1 } {
+ return [expr $i + 1]
+ } else {
+ return -1
+ }
+}
+#;>
+# Retourne a partir d'un full path le nom du report
+#;<
+proc pstore:Report:Head { fullpath } {
+ if [regexp {.*/([0-9]*,[^/]*)} $fullpath all rep] {
+ return $rep
+ } else {
+ return {}
+ }
+}
+#;
+# Retourne la longueur de la liste des reports en attente dans shop
+#;<
+proc pstore:Report:QueueLength { fshop } {
+ return [llength [pstore:Report:GetReportList [pstore:Report:GetRootName]]]
+}
+
+#;>
+# Commande utilise pour le tri ci dessus: (u,string1 > v,string2 <=> u > v)
+#;<
+proc pstore:Report:SortEntry { a b } {
+ set lna [split $a ,]
+ set lnb [split $b ,]
+ return [expr [lindex $lna 0] - [lindex $lnb 0] ]
+}
+
+;#
+;# Retourne un ou plusieurs pathes de report, mangeables par pstore:Report:Process
+;#
+proc pstore:Report:Get { id fshop } {
+ set l {}
+ if { [pstore:Report:QueueLength $fshop] != 0 } {
+ set FrigoName [pstore:Report:GetRootName]
+ if { $FrigoName != {} } {
+ set ListReport [pstore:Report:GetReportList $FrigoName]
+ if { $ListReport != {} } {
+ if { "$id" == "all" } {
+ foreach e $ListReport {
+ lappend l $FrigoName/$e
+ }
+ } else {
+ set brep [pstore:Report:GetTrueName $id $ListReport]
+ if { "$brep" != "" } {
+ lappend l $FrigoName/$brep
+ }
+ }
+ } else {
+ msgprint -c WOKBAG -e "Unable to get report list."
+ }
+ } else {
+ msgprint -c WOKBAG -e "Administration directory for $fshop not found. No report was stored."
+ }
+ } else {
+ msgprint -c WOKBAG -i "Report queue is empty."
+ }
+ return $l
+}
+;#
+;# Create root for report's queue.
+;#
+proc pstore:Report:MkRoot { fshop {create 0} } {
+ set root [pstore:Report:GetRootName]
+ if [file exists $root] {
+ return $root
+ } else {
+ if { $create } {
+ wokUtils:DIR:create $root
+ chmod 0777 $root
+ return $root
+ } else {
+ return {}
+ }
+ }
+}
+;#
+;# Actually send the mail.
+;# The user "from"
+;# The subject
+;#
+proc pstore:mail:Send { subject text } {
+ foreach user [pstore:mail:Users] {
+ wokUtils:EASY:mail $user [id user] {} $subject $text send
+ }
+
+}
projects / occt-wok.git / commitdiff