--- /dev/null
+srcinc:::Browser.tcl
+srcinc:::BrowserOMT.tcl
+srcinc:::BrowserSearch.tcl
+srcinc:::FILES
+srcinc:::MkBuild.tcl
+srcinc:::wokNAV.tcl
+srcinc:::WCOMPATIBLE.tcl
+srcinc:::WOKVC.tcl
+srcinc:::WOKVC.RCS
+srcinc:::WOKVC.SCCS
+srcinc:::WOKVC.ClearCase
+srcinc:::WOKVC.NOBASE
+srcinc:::upack.tcl
+srcinc:::wbuild.tcl
+srcinc:::wok-comm.el
+srcinc:::wok.tcl
+srcinc:::wokCreations.tcl
+srcinc:::wokDeletions.tcl
+srcinc:::wokStuff.tcl
+srcinc:::wokemacs.tcl
+srcinc:::wokclient.tcl
+srcinc:::wokinit.tcl
+srcinc:::wokprocs.tcl
+srcinc:::wokinterp.tcl
+srcinc:::wprepare.tcl
+srcinc:::wstore.tcl
+srcinc:::woksh.el
+srcinc:::woksh.el-wnt
+srcinc:::wutils.tcl
+srcinc:::Wok_Init.tcl
+srcinc:::wokEDF.tcl
+srcinc:::wstore_trigger.example
+srcinc:::wnews_trigger.example
+srcinc:::pinstall.tcl
+srcinc:::scheck.tcl
+srcinc:::wbuild.hlp
+srcinc:::wokRPRHelp.hlp
+srcinc:::wokWaffQueueHelp.hlp
+srcinc:::wokPrepareHelp.hlp
+srcinc:::wokEDF.hlp
+srcinc:::wokMainHelp.hlp
+srcinc:::ptypefile.tcl
+srcinc:::VC.example
+srcinc:::wcheck.tcl
+srcinc:::wnews.tcl
+srcinc:::tclx.nt
+srcinc:::wokclient.tcl
+srcinc:::p-ul.tcl
+srcinc:::wokPRM.tcl
+srcinc:::wokPRM.hlp
+srcinc:::MatraDatavision.xpm
+srcinc:::reposit.xpm
+srcinc:::abstract.xpm
+srcinc:::admin.xpm
+srcinc:::back.xpm
+srcinc:::browser.xpm
+srcinc:::caution.xpm
+srcinc:::ccl.xpm
+srcinc:::ccl_open.xpm
+srcinc:::client.xpm
+srcinc:::client_open.xpm
+srcinc:::create.xpm
+srcinc:::danger.xpm
+srcinc:::delete.xpm
+srcinc:::delivery.xpm
+srcinc:::delivery_open.xpm
+srcinc:::documentation.xpm
+srcinc:::documentation_open.xpm
+srcinc:::engine.xpm
+srcinc:::engine_open.xpm
+srcinc:::executable.xpm
+srcinc:::executable_open.xpm
+srcinc:::factory.xpm
+srcinc:::factory_open.xpm
+srcinc:::file.xpm
+srcinc:::frontal.xpm
+srcinc:::frontal_open.xpm
+srcinc:::gettable.xpm
+srcinc:::idl.xpm
+srcinc:::idl_open.xpm
+srcinc:::interface.xpm
+srcinc:::interface_open.xpm
+srcinc:::journal.xpm
+srcinc:::nocdlpack.xpm
+srcinc:::nocdlpack_open.xpm
+srcinc:::notes.xpm
+srcinc:::package.xpm
+srcinc:::package_open.xpm
+srcinc:::params.xpm
+srcinc:::parcel.xpm
+srcinc:::parcel_open.xpm
+srcinc:::patch.xpm
+srcinc:::patches.xpm
+srcinc:::persistent.xpm
+srcinc:::pqueue.xpm
+srcinc:::prepare.xpm
+srcinc:::private.xpm
+srcinc:::queue.xpm
+srcinc:::resource.xpm
+srcinc:::resource_open.xpm
+srcinc:::rotate.xpm
+srcinc:::schema.xpm
+srcinc:::schema_open.xpm
+srcinc:::server.xpm
+srcinc:::server_open.xpm
+srcinc:::storable.xpm
+srcinc:::textfile_adm.xpm
+srcinc:::textfile_rdonly.xpm
+srcinc:::toolkit.xpm
+srcinc:::toolkit_open.xpm
+srcinc:::transient.xpm
+srcinc:::unit.xpm
+srcinc:::unit_open.xpm
+srcinc:::unit_rdonly.xpm
+srcinc:::wbuild.xpm
+srcinc:::work.xpm
+srcinc:::workbench.xpm
+srcinc:::workbench_open.xpm
+srcinc:::workshop.xpm
+srcinc:::workshop_open.xpm
+srcinc:::bylong.xbm
+srcinc:::byrow.xbm
+srcinc:::bycol.xbm
+srcinc:::bylast.xbm
+srcinc:::see.xpm
+srcinc:::see_closed.xpm
+srcinc:::source.xpm
+srcinc:::cell.xpm
+srcinc:::wokcd.xpm
+srcinc:::warehouse.xpm
+srcinc:::arb.tcl
+srcinc:::dep.tcl
+srcinc:::path.xpm
+srcinc:::wokSEA.tcl
+srcinc:::wokPROP.tcl
+srcinc:::wokOUC.tcl
+srcinc:::news_cpwb.tcl
+srcinc:::cback.xpm
+srcinc:::cfrwd.xpm
+srcinc:::wokRPR.tcl
+srcinc:::wokCOO.tcl
+srcinc:::wokQUE.tcl
+srcinc:::wcompare.tcl
+srcinc:::envir.xpm
+srcinc:::envir_open.xpm
--- /dev/null
+
+#############################################################################
+#
+# W I N T E G R E
+# _______________
+#
+#############################################################################
+#
+# Usage
+#
+proc wokIntegreUsage { } {
+ puts stderr { }
+ puts stderr { usage : wintegre [ <reportID> ]}
+ puts stderr { }
+ puts stderr { <reportID> is a number. The range of the report in the queue.}
+ puts stderr { You get this number by using the command : wstore -ls }
+ puts stderr { }
+ puts stderr { -ref <Base-number> }
+ puts stderr { Used to init version of elements in the repository.}
+ puts stderr { }
+ puts stderr { -all : Process all reports in the queue. }
+ puts stderr { }
+ puts stderr { -norefcopy: Update the repository but don't update target workbench." }
+ puts stderr { -nobase : Update the target workbench but don't update the repository. }
+ puts stderr { These 2 previous options are mutually exclusive. }
+ puts stderr { -ws Shop : Use Shop as working shop. Shop has the form Factory:shop. }
+ puts stderr { Default is the current workshop. }
+ puts stderr { -root wb : Use wb as the target workbench. }
+ puts stderr { -param : Show the current value of parameters. }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc wintegre { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-ref) value_required:number
+ set tblreq(-all) {}
+ set tblreq(-norefcopy) {}
+ set tblreq(-nobase) {}
+ set tblreq(-ws) value_required:string
+ set tblreq(-root) value_required:string
+ set tblreq(-V) {}
+ set tblreq(-param) {}
+
+ set disallow(-nobase) {-norefcopy}
+ set disallow(-norefcopy) {-nobase}
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokIntegreUsage $args] == -1 } return
+ if { [wokUtils:EASY:DISOPT tabarg disallow wokIntegreUsage ] == -1 } return
+
+ set VERBOSE [info exists tabarg(-V)]
+
+ if { $VERBOSE } {
+ puts "param = $param"
+ catch {parray tabarg}
+ }
+
+ if { [info exists tabarg(-h)] } {
+ wokIntegreUsage
+ return
+ }
+
+ if [info exists tabarg(-ws)] {
+ set fshop $tabarg(-ws)
+ } else {
+ set fshop [Sinfo -s]
+ }
+
+ if { [info exists tabarg(-param)] } {
+ wokIntegre:BASE:GetType $fshop 1
+ return
+ }
+
+ if { [set refer [info exists tabarg(-ref)]] } {
+ set vrsref $tabarg(-ref)
+ }
+
+ set refcopy [expr ![info exists tabarg(-norefcopy)]]
+ set nobase [info exists tabarg(-nobase)]
+
+ if [info exists tabarg(-root)] {
+ set wbtop $tabarg(-root)
+ msgprint -c WOKVC -i "Using $wbtop as target workbench."
+ } else {
+ set wbtop [wokIntegre:RefCopy:GetWB $fshop]
+ }
+
+ if { [info exists tabarg(-all)] } {
+ set LISTREPORT [wokStore:Report:Get all $fshop ]
+ } else {
+ if { [llength $param] == 1 } {
+ set ID [lindex $param 0]
+ set LISTREPORT [wokStore:Report:Get $ID $fshop ]
+ } else {
+ wokIntegreUsage
+ return -1
+ }
+ }
+
+ ;# fin analyse des arguments
+
+ if { $VERBOSE } {
+ puts stderr "refer = $refer"
+ if { $refer } { puts stderr " vrsref = $vrsref" }
+ puts stderr "refcopy = $refcopy"
+ puts stderr "nobase = $nobase"
+ puts stderr "fshop = $fshop"
+ puts stderr "wbtop = $wbtop"
+ puts stderr "LISTREPORT = $LISTREPORT"
+ }
+
+ if { [set BTYPE [wokIntegre:BASE:InitFunc $fshop]] == {} } {
+ return -1
+ }
+ ;#
+ ;# ClearCase : La base n'est pas geree par WOK
+ ;#
+ if { "$BTYPE" == "ClearCase" } {
+ wokIntegreClearCase
+ return
+ }
+ ;#
+ ;# Autre : SCCS, RCS, NOBASE, SIMPLE geree par WOK
+ ;#
+ set broot [wokIntegre:BASE:GetRootName $fshop 1]
+ if ![file writable $broot] {
+ msgprint -c WOKVC -e "You cannot write in $broot."
+ return -1
+ }
+
+ if { "$BTYPE" == "NOBASE" } {
+ wokIntegrenobase
+ } else {
+ if { $nobase } {
+ wokIntegrenobase
+ } else {
+ wokIntegrebase
+ }
+ }
+ return
+}
+#;>
+# Traitement des bazes ClearCase
+#;<
+proc wokIntegreClearCase { } {
+ uplevel {
+ puts "Integre dans bases ClearCase"
+ foreach REPORT $LISTREPORT {
+ if { $VERBOSE } { msgprint -c WOKVC -i "Processing report in $REPORT" }
+ set comment ""
+ ;#
+ ;# Lecture du report
+ ;#
+ set mode normal
+ if { $refer } { set mode ref }
+ catch {unset table}
+ set stat [wokStore:Report:Process $mode $REPORT table info notes]
+
+ foreach UD [lsort [array names table]] {
+ puts stdout [format "echo Processing unit : %s" $UD]
+ set root [wokIntegre:BASE:GetVOBName [Sinfo -f] $shop $wbtop $UD]
+ if { $root != {} } {
+ foreach ELM $table($UD) {
+ set F [lindex $ELM 1]
+ set name [file tail $F]
+ set sfl $root/$name
+ if [file exists $sfl] {
+ set cmdco "cleartool co -nda -nc $sfl"
+ if { [lindex [set resco [wokUtils:EASY:command $cmdco 1 0]] 0] == 1 } {
+ } else {
+ msgprint -c WOKVC -e "ClearCase checkout failed for $sfl"
+ }
+ set cmdci "cleartool ci -c $comment -from $F $sfl"
+ if { [lindex [set resci [wokUtils:EASY:command $cmdci 1 0]] 0] == 1 } {
+ } else {
+ msgprint -c WOKVC -e "ClearCase checkin failed for $sfl"
+ }
+ } else {
+ set cmdco "cleartool co -nc $root";# check out directory
+ if { [lindex [set resco [wokUtils:EASY:command $cmdco 1 0]] 0] == 1 } {
+ } else {
+ msgprint -c WOKVC -e "ClearCase checkout failed for $sfl"
+ }
+ wokUtils:FILES:copy $F $sfl ;# copy element dans la base
+ set cmdmk "cleartool mkelem -ci -c $comment $sfl" ;# creation elem
+ if { [lindex [set resmk [wokUtils:EASY:command $cmdmk 1 0]] 0] == 1 } {
+ } else {
+ msgprint -c WOKVC -e "ClearCase checkout failed for $sfl"
+ }
+ set cmdci "cleartool ci -c $comment $root"
+ }
+ }
+ } else {
+ msgprint -c WOKVC -e "The unit $UD has no entry in the VOB $wbtop"
+ }
+ }
+ }
+ }
+ return
+}
+#;>
+# retourne le path de la vob associee a fact-shop-wb-UD.
+#:<
+proc wokIntegre:BASE:GetVOBName { fact shop wb UD } {
+ return /vobs/GRIV/k1dev/k1dev/V3d/src
+ set ud [lindex [split $UD .] 0]
+ if [wokinfo -x ${wb}:${ud}] {
+ return [wokinfo -p source:. ${wb}:${ud}]
+ } else {
+ return {}
+ }
+}
+#;>
+# Miscellaneous: Assemblage traitement avec base
+#;<
+proc wokIntegrebase { } {
+ uplevel {
+ foreach REPORT $LISTREPORT {
+ if { $VERBOSE } { msgprint -c WOKVC -i "Processing report in $REPORT" }
+ set num [wokIntegre:Number:Get $fshop 1]
+ if { [wokUtils:FILES:dirtmp [set dirtmp /tmp/wintegre[id process]]] == -1 } {
+ msgprint -c WOKVC -e "Unable to create working directory"
+ return -1
+ }
+ set jnltmp $dirtmp/wintegre.jnl
+ set jnlid [open $jnltmp w]
+ set comment [wokIntegre:Journal:Mark [wokinfo -n [wokinfo -s $fshop]] $num rep]
+ ;#
+ ;# Lecture du report
+ ;#
+ set mode normal
+ if { $refer } { set mode ref }
+ catch {unset table}
+ set stat [wokStore:Report:Process $mode $REPORT table info notes]
+ if { $stat == -1 } {
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+ ;#
+ ;# Recup version associee a l'ilot et Inits
+ ;#
+ if { $refer } {
+ set version [wokIntegre:Version:Check $fshop $vrsref]
+ set func wokIntegre:BASE:InitRef
+ } else {
+ set version [wokIntegre:Version:Get $fshop]
+ set func wokIntegre:BASE:UpdateRef
+ }
+
+ if { $version == {} } {
+ msgprint -c WOKVC -e "Unable to get base version for $fshop"
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+ ;#
+ ;# 1. Bases temporaires : Ecriture de la commande
+ ;#
+ set cmdtmp $dirtmp/wintegre.cmd
+ set cmdid [open $cmdtmp w]
+
+ $func $broot table $version $comment $cmdid
+ wokIntegre:BASE:EOF $cmdid ; close $cmdid
+
+ ;#
+ ;# 1 bis. Tester [id user] peut ecrire dans le workbench qui sert de REFCOPY
+ ;#
+ if { $refcopy == 1 } {
+ set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop]
+ if { $write_ok == -1 } {
+ msgprint -c WOKVC -e "You cannot write or create units in the workbench $wbtop"
+ wokIntegreCleanup $broot table [list $cmdid $jnlid] $dirtmp
+ return -1
+ }
+ }
+
+ ;#
+ ;# 2. Bases temporaires : Execution et ecriture journal temporaire
+ ;#
+ wokPrepare:Report:ReadInfo $info station workshop workbench
+ wokIntegre:Journal:WriteHeader rep $num $workbench $station $jnlid
+
+ set statx [wokIntegre:BASE:Execute $VERBOSE $cmdtmp $jnlid]
+ if { $statx != 1 } {
+ set cmd [file tail $cmdtmp]
+ wokUtils:FILES:copy $cmdtmp $cmd
+ wokIntegreCleanup $broot table [list $cmdid $jnlid] $dirtmp
+ msgprint -c WOKVC -e "occuring while creating temporary bases. Repository not modified."
+ msgprint -c WOKVC -e "Dump script in file [pwd]/$cmd"
+ return -1
+ }
+
+ ;#
+ ;# 3. Ecriture Bases definitives
+ ;#
+ foreach UD [lsort [array names table]] {
+ msgprint -c WOKVC -i [format "Updating unit %s in repository" $UD]
+ wokIntegre:BASE:Fill $broot/$UD [wokIntegre:BASE:BTMPCreate $broot $UD 0]
+ }
+
+
+ ;#
+ ;# 4. Fermer le journal temporaire
+ ;#
+ wokIntegre:Journal:WriteNotes $notes $jnlid ; close $jnlid
+
+ ;#
+ ;# 5. Mettre a jour le journal , le scoop et le compteur et le numero de version si -ref
+ ;#
+ wokUtils:FILES:concat [wokIntegre:Journal:GetName $fshop 1] $jnltmp
+ wokIntegre:Scoop:Create $fshop $jnltmp
+
+ if { [wokIntegre:Number:Put $fshop [wokIntegre:Number:Incr $fshop]] == {} } {
+ msgprint -c WOKVC -e "during update of counter."
+ wokIntegreCleanup $broot table [list $cmdid $jnlid] $dirtmp
+ return -1
+ }
+
+ if { $refer } {
+ wokIntegre:Version:Put $fshop $version
+ }
+
+ ;#
+ ;# 6. Si refcopy = 1 Mise a jour de WBTOP
+ ;#
+ if { $refcopy == 1 } {
+ catch {unset table}
+ wokIntegre:Journal:PickReport $jnltmp table notes $num
+ wokIntegre:RefCopy:GetPathes $fshop table $wbtop
+ set dirtmpu /tmp/wintegrecreateunits[id process]
+ catch {
+ rmdir -nocomplain $dirtmpu
+ mkdir -path $dirtmpu
+ }
+ set chkout $dirtmpu/checkout.cmd
+ set chkid [open $chkout w]
+ wokIntegre:RefCopy:FillRef $fshop table $chkid
+ wokIntegre:BASE:EOF $chkid
+ close $chkid
+ msgprint -c WOKVC -i "Updating units in workbench $wbtop"
+ set statx [wokIntegre:BASE:Execute $VERBOSE $chkout]
+ if { $statx != 1 } {
+ msgprint -c WOKVC -e "during checkout(Get). The report has not been removed."
+ wokIntegreCleanup $broot table [list $chkid] [list $dirtmpu]
+ return -1
+ }
+ wokIntegreCleanup $broot table [list $chkid] [list $dirtmpu]
+ }
+
+ ;#
+ ;# 8. Detruire le report et menage
+ ;#
+ wokStore:Report:Del $REPORT 1
+ wokIntegreCleanup $broot table [list $cmdid $jnlid] [list $dirtmp]
+ }
+ }
+}
+#;>
+# Miscellaneous: Assemblage traitement sans mise a jour de la base.
+#;<
+proc wokIntegrenobase { } {
+ uplevel {
+ foreach REPORT $LISTREPORT {
+ if { $VERBOSE } {msgprint -c WOKVC -i "Processing report in $REPORT"}
+ set num [wokIntegre:Number:Get $fshop 1]
+ if { [wokUtils:FILES:dirtmp [set dirtmp /tmp/wintegre[id process]]] == -1 } {
+ msgprint -c WOKVC -e "Unable to create working directory"
+ return -1
+ }
+ set jnltmp $dirtmp/wintegre.jnl
+ set jnlid [open $jnltmp w]
+ set comment [wokIntegre:Journal:Mark [wokinfo -n [wokinfo -s $fshop]] $num rep]
+ ;#
+ ;# Lecture du report
+ ;#
+ catch {unset table}
+ set stat [wokStore:Report:Process normal $REPORT table info notes]
+ if { $stat == -1 } {
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+
+ set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop]
+ if { $write_ok == -1 } {
+ msgprint -c WOKVC -e "You cannot write or create units in the workbench $wbtop"
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+ set pathes_ok [wokIntegre:RefCopy:GetPathes $fshop table $wbtop]
+ if { $write_ok == -1 } {
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+
+ wokPrepare:Report:ReadInfo $info station workshop workbench
+ wokIntegre:Journal:WriteHeader rep $num $workbench $station $jnlid
+
+ set copy_ok [wokIntegre:RefCopy:Copy $VERBOSE table $jnlid]
+ if { $copy_ok == -1 } {
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+ wokIntegre:Journal:WriteNotes $notes $jnlid ; close $jnlid
+ wokUtils:FILES:concat [wokIntegre:Journal:GetName $fshop 1] $jnltmp
+ if { [wokIntegre:Number:Put $fshop [wokIntegre:Number:Incr $fshop]] == {} } {
+ msgprint -c WOKVC -e "during update of counter."
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ return -1
+ }
+
+ wokStore:Report:Del $REPORT 1
+ wokIntegreCleanup $broot table [list $jnlid] $dirtmp
+ }
+ }
+}
+#;>
+#
+# Miscellaneous: Fait le menage apres wintegre
+#
+# listid : liste de file descripteur a fermer
+# dirtmp : liste de repertoire a demolir
+# table : liste des UDs contenant une base temporaire
+#;<
+proc wokIntegreCleanup { broot table listid dirtmp } {
+ upvar table TLOC
+
+ foreach UD [array names TLOC] {
+ wokIntegre:BASE:BTMPDelete $broot $UD
+ }
+ if [info exists listid] {
+ foreach id $listid {
+ catch { close $id }
+ }
+ }
+ if [info exists dirtmp] {
+ foreach d $dirtmp {
+ catch { wokUtils:FILES:removedir $d }
+ }
+ }
+ return
+}
+#;>
+# Charge l'interface necessaire pour acceder aux bases de la factory.
+# Se fait en fonction du type de repository code dans le parametre VC_TYPE
+#
+#;<
+proc wokIntegre:BASE:InitFunc { fshop } {
+ global env
+ set wdir $env(WOK_LIBRARY)
+ set type [wokIntegre:BASE:GetType $fshop ]
+ if { $type != {} } {
+ set interface $wdir/WOKVC.$type
+ if [file exist $interface] {
+ uplevel #0 source $interface
+ return $type
+ } else {
+ msgprint -c WOKVC -e "File $interface not found."
+ return {}
+ }
+ } else {
+ msgprint -c WOKVC -w "Unknown type for source repository."
+ return {}
+ }
+}
+#;>
+# Retourne le type de la base courante. {} sinon => utiliser ca pour savoir si il y en une !!
+#;<
+proc wokIntegre:BASE:GetType { fshop {dump 0} } {
+ set lvc [wokparam -l VC $fshop]
+ if { $lvc != {} } {
+ if { [lsearch -regexp $lvc %VC_TYPE=*] != -1 } {
+ if { $dump } {
+ foreach dir [wokparam -L $fshop] {
+ if [file exists $dir/VC.edl] {
+ msgprint -c WOKVC -i "Following definitions in file : $dir/VC.edl"
+ break
+ }
+ }
+ msgprint -c WOKVC -i "Repository root : [wokparam -e %VC_ROOT $fshop]"
+ msgprint -c WOKVC -i "Repository type : [wokparam -e %VC_TYPE $fshop]"
+ msgprint -c WOKVC -i "Attached to : [wokIntegre:RefCopy:GetWB $fshop]"
+ }
+ return [wokparam -e %VC_TYPE $fshop]
+ } else {
+ return {}
+ }
+ } else {
+ return {}
+ }
+}
+#;>
+#######################################################################
+# Updater la reference : Ecriture du fichier de commande base temporaire
+#
+# table : table des UDs a traiter ( il ya des flags + - # )
+# vrs : version a utiliser
+# comment: Commentaire a coller dans l'historique PAS DE BLANC
+# fileid : file descriptor
+#######################################################################
+#;<
+proc wokIntegre:BASE:UpdateRef { broot table vrs comment fileid } {
+ upvar table TLOC
+ foreach UD [lsort [array names TLOC]] {
+ set tmpud [wokIntegre:BASE:BTMPCreate $broot $UD 1]
+ puts $fileid [format "echo Processing unit : %s" $UD]
+ puts $fileid [format "cd %s" $tmpud]
+ set root $broot/$UD
+ foreach ELM $TLOC($UD) {
+ set mark _[lindex $ELM 0]
+ set F [lindex $ELM 1]
+ set bna [file tail $F]
+ set sfl $root/[wokIntegre:BASE:ftos $bna $vrs]
+ switch $mark {
+
+ _+ {
+ if [file exists $sfl] {
+ ;#puts "Coucou: reapparition de $sfl"
+ wokIntegre:BASE:UpdateFile $sfl $vrs $comment $F $fileid
+ } else {
+ wokIntegre:BASE:InitFile $F $vrs $comment \
+ $tmpud/[wokIntegre:BASE:ftos $bna $vrs] $fileid
+ }
+ }
+
+ _# {
+ if [file exists $sfl] {
+ wokIntegre:BASE:UpdateFile $sfl $vrs $comment $F $fileid
+ } else {
+ wokIntegre:BASE:InitFile $F $vrs $comment \
+ $tmpud/[wokIntegre:BASE:ftos $bna $vrs] $fileid
+ }
+ }
+
+ _- {
+ wokIntegre:BASE:DeleteFile $bna $fileid
+ }
+ }
+ }
+ }
+ return
+}
+#;>
+#######################################################################
+# Init d'une reference: Ecriture du fichier de commande base temporaire
+#
+# table : table des UDs a traiter
+# vrs : version de base a creer
+# comment: Commentaire a coller dans l'historique
+# fileid : file descriptor
+########################################################################
+#;<
+proc wokIntegre:BASE:InitRef { broot table vrs comment fileid } {
+ upvar table TLOC
+ foreach UD [lsort [array names TLOC]] {
+ set tmpud [wokIntegre:BASE:BTMPCreate $broot $UD 1]
+ puts $fileid [format "echo Processing unit : %s" $UD]
+ puts $fileid [format "cd %s" $tmpud]
+ set root $broot/$UD
+ foreach F $TLOC($UD) {
+ set bna [file tail $F]
+ set sfl $root/[wokIntegre:BASE:ftos $bna $vrs]
+ if [file exists $sfl] {
+ wokIntegre:BASE:ReInitFile $sfl $vrs $comment $F $fileid
+ } else {
+ wokIntegre:BASE:InitFile $F $vrs $comment $tmpud/[wokIntegre:BASE:ftos $bna $vrs] $fileid
+ }
+ }
+ }
+ return
+}
+#;>
+# Remplit une base Bname avec les elements de elmin (full pathes)
+# Si la base n'existe pas la cree.
+# Par defaut le remplissage se fait avec frename (mv)
+# Pour faire une copie (cp) action = copy (pas traite)
+# Seuls les fichiers commencant par s. sont traites
+# (sfiles ou des directories de sfiles)
+#;<
+proc wokIntegre:BASE:Fill { broot elmin {action move} } {
+ set bdir $broot
+ if ![file exists $bdir] {
+ mkdir -path $bdir
+ chmod 0777 $bdir
+ }
+
+ foreach e $elmin {
+ if { [file isfile $e] } {
+ set bna [file tail $e]
+ catch { frename $e $bdir/$bna }
+ } elseif { [file isdirectory $e] } {
+ set dl {}
+ foreach f [readdir $e] {
+ lappend dl $e/$f
+ }
+ wokIntegre:BASE:Fill $broot $dl $action
+ }
+ }
+ return $bdir
+}
+#;>
+# Detruit une base Bname.
+#;<
+proc wokIntegre:BASE:Delete { fshop Bname } {
+ if [catch { exec rm -rf [wokIntegre:BASE:GetRootName $fshop]/$Bname } status ] {
+ msgprint -c WOKVC -e "BASE:Delete $status"
+ return -1
+ }
+ return 1
+}
+
+#;>
+# retourne le nom de la racine ou les bases sont accrochees.
+# Il y a une etage de plus par rapport aux anciennes bases pour faciliter
+# les tests et la sauvegarde.
+#;<
+proc wokIntegre:BASE:GetRootName { fshop {create 0} } {
+ set diradm [wokparam -e %VC_ROOT $fshop]/BASES
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating file $diradm"
+ mkdir -path $diradm
+ chmod 0755 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# retourne 1 si le user courant peut ecrire dans les base de l'atelier courant
+#;<
+proc wokIntegre:BASE:Writable { fshop } {
+ return [file writable [wokIntegre:BASE:GetRootName $fshop]]
+}
+#;>
+# retourne la liste des bases sous la forme { {name ext} ... {name ext} }
+#;<
+proc wokIntegre:BASE:LS { fshop } {
+ set l {}
+ set r [wokIntegre:BASE:GetRootName $fshop]
+ if [file exists $r] {
+ foreach e [lsort [readdir $r]] {
+ if { [string compare [file type $r/$e] file] != 0 } {
+ lappend l [list [file root $e] [file extension $e]]
+ }
+ }
+ }
+ return $l
+}
+#;>
+# retourne la liste des bases ayant une base temporaire
+#;<
+proc wokIntegre:BASE:BTMPLS { fshop } {
+ set l {}
+ set r [wokIntegre:BASE:GetRootName $fshop]
+ if [file exists $r] {
+ foreach e [lsort [readdir $r]] {
+ if [file exists $r/$e/tmp] {
+ lappend l $e
+ }
+ }
+ }
+ return $l
+}
+#;>
+# retourne le nom de la base temporaire associee a une Unit. Si create la cree
+#;<
+proc wokIntegre:BASE:BTMPCreate { broot Unit {create 0} } {
+ if { $create } {
+ wokIntegre:BASE:BTMPDelete $broot $Unit
+ mkdir -path $broot/$Unit/tmp
+ }
+ return $broot/$Unit/tmp
+}
+#;>
+# detruit la base temporaire associee a une Unit.
+# Le directory est vide puis detruit. Il y a un seul niveau
+# Le directory courant ne doit pas etre unit/tmp
+#;<
+proc wokIntegre:BASE:BTMPDelete { broot Unit } {
+ set R $broot/$Unit/tmp
+ if [file exists $R] {
+ foreach f [readdir $R] {
+ unlink $R/$f
+ }
+ rmdir -nocomplain $R
+ }
+ return 1
+}
+#
+# ((((((((((((((((REFCOPY))))))))))))))))
+#
+#;>
+# Check owner et fait ucreate si necessaire des UDs de table
+# 1. ucreate -p workbench:NTD si owner OK
+#;<
+proc wokIntegre:RefCopy:Writable { fshop table workbench } {
+ upvar $table TLOC
+ foreach UD [array names TLOC] {
+ regexp {(.*)\.(.*)} $UD ignore name type
+ if { [lsearch [w_info -l ${fshop}:${workbench}] $name ] == -1 } {
+ ;# if workbench is writable ..
+ ;#msgprint -c WOKVC -i "Creating unit ${fshop}:${workbench}:${name}"
+ ucreate -$type ${fshop}:${workbench}:${name}
+ }
+ set dirsrc [wokinfo -p source:. ${fshop}:${workbench}:${name}]
+ if ![file writable $dirsrc] {
+ msgprint -c WOKVC -e "You cannot write in directory $dirsrc"
+ return -1
+ }
+ }
+ return 1
+}
+
+#;>
+# 1. Met en tete des elements de table (liste) le liste le full path du repertoire a alimenter
+# SOUS RESERVE QUE LES UDS aient deja ete crees.
+# Input: table(NTD.p) = { {toto.c 2.1} {titi.c 4.3} }
+# Output: table(NTD.p) = { /home/wb/qqchose/NTD/src {toto.c 2.1} {titi.c 4.3} }
+#;<
+proc wokIntegre:RefCopy:GetPathes { fshop table workbench } {
+ upvar $table TLOC
+ foreach UD [array names TLOC] {
+ regexp {(.*)\.(.*)} $UD ignore name type
+ if { [lsearch [w_info -l ${fshop}:$workbench] $name ] != -1 } {
+ set lsf $TLOC($UD)
+ set TLOC($UD) [linsert $lsf 0 [wokparam -e %${name}_Src ${fshop}:${workbench}:${name}]]
+ } else {
+ msgprint -c WOKVC -e "(GetPathes) Unit $name not found in $workbench"
+ return -1
+ }
+ }
+ return 1
+}
+#;>
+# Modifie si c'est possible les protections des elements de table (liste)
+# si ils appartiennent a <user>
+# Utilise par wget en reference
+# Input: table(NTD.p) = { /home/wb/qqchose/NTD/src {toto.c 2.1} {titi.c 4.3} }
+#;<
+proc wokIntegre:RefCopy:SetWritable { table user } {
+ upvar $table TLOC
+ foreach UD [array names TLOC] {
+ set dirsrc [lindex $TLOC($UD) 0]
+ foreach e [lrange $TLOC($UD) 1 end] {
+ set file $dirsrc/[lindex $e 0]
+ if [file owned $file] {
+ chmod u+w $file
+ } else {
+ msgprint -c WOKVC -e "Protection of $file cannot be modified (File not found or not owner)."
+ return -1
+ }
+ }
+ }
+ return 1
+}
+#;>
+# Copy les elements de table (liste) dans le repertoire associe
+# Utilise par wintegre -nobase
+# Input: table(NTD.p) = { /home/wb/qqchose/NTD/src {flag1 path1} {flag2 path2} }
+# path : adresse du fichier dans le frigo.
+# Retour: { ... {p1 p2} ... } si OK {} sinon
+#;<
+proc wokIntegre:RefCopy:Copy { VERBOSE table {fileid stdout} } {
+ upvar $table TLOC
+
+ catch { unset err }
+ set LUD [lsort [array names TLOC]]
+ foreach ud $LUD {
+ set lret {}
+ set dirsrc [lindex $TLOC($ud) 0]
+ foreach e [lrange $TLOC($ud) 1 end] {
+ if { "[lindex $e 0]" != "-" } {
+ set fromp [lindex $e 1]
+ set file [file tail $fromp]
+ set destp $dirsrc/$file
+ if { [file exists $fromp] } {
+ if { [file exists $destp] } {
+ if { [file owned $destp] } {
+ lappend lret [list [format " Modified : %s -.-" $file] $fromp $destp]
+ } else {
+ msgprint -c WOKVC -e "Protection of $destp cannot be modified (not owner)."
+ set err 1
+ break
+ }
+ } else {
+ if { [file writable [file dirname $destp]] } {
+ lappend lret [list [format " Added : %s -.-" $file] $fromp $destp]
+ } else {
+ msgprint -c WOKVC -e "File $destp cannot be created (permission denied)."
+ set err 1
+ break
+ }
+ }
+ } else {
+ msgprint -c WOKVC -e "File $fromp doesnt not exists."
+ set err 1
+ break
+ }
+ }
+ }
+ if [info exists err ] { break }
+ set TLOC($ud) $lret
+ }
+
+ if [info exists err] {
+ msgprint -c WOKVC -i "No file copied."
+ return -1
+ }
+
+ foreach ud $LUD {
+ puts $fileid [format "\n %s (Updated) : \n----" $ud]
+ msgprint -c WOKVC -i [format " %s (Updated) : \n----" $ud]
+ foreach d $TLOC($ud) {
+ set straff [lindex $d 0]
+ set fromp [lindex $d 1]
+ set destp [lindex $d 2]
+ msgprint -c WOKVC -i $straff
+ puts $fileid $straff
+ if { [file exists $destp] } {
+ chmod 0644 $destp
+ }
+ if { $VERBOSE } { msgprint -c WOKVC -i "Copying $fromp $destp"}
+ wokUtils:FILES:copy $fromp $destp
+ chmod 0444 $destp
+ }
+ }
+
+ return 1
+}
+#;>
+# Ecriture du fichier de commande pour remplir ce qui se trouve decrit dans table
+# (format :Journal:PickReport modifie par wokIntegre:RefCopy:Getpathes )
+# Si un fichier a creer existe deja et est writable, il est renomme en -sav
+# Comportement correspondant au remplissage du workbench de reference
+#;<
+proc wokIntegre:RefCopy:FillRef { fshop table {fileid stdout} } {
+ upvar $table TLOC
+ foreach UD [array names TLOC] {
+ set lsf $TLOC($UD)
+ set dirsrc [lindex $lsf 0]
+ puts $fileid "cd $dirsrc"
+ set root [wokIntegre:BASE:GetRootName $fshop]/$UD
+ set i [llength $lsf]
+ while { $i > 1 } {
+ set i [expr $i-1]
+ set elm [lindex $lsf $i]
+ set vrs [lindex $elm 1]
+ set file [lindex $elm 0]
+ if { [string compare $vrs x.x] != 0 } {
+ if [file writable $dirsrc/$file] {
+ frename $dirsrc/$file $dirsrc/${file}-sav
+ msgprint -c WOKVC -i "File $dirsrc/$file renamed ${file}-sav"
+ }
+ set Sfile $root/[wokIntegre:BASE:ftos $file $vrs]
+ wokIntegre:BASE:GetFile $Sfile $vrs $fileid
+ }
+ }
+ }
+ return
+}
+#;>
+# Ecriture du fichier de commande pour remplir ce qui se trouve decrit dans table
+# (format :Journal:PickReport modifie par wokIntegre:RefCopy:Getpathes )
+# Si un fichier a creer existe deja, il n'est pas ecrase
+# Comportement correspondant au remplissage d'une UD avec wget.
+# On change aussi la protection du fichier cree (writable pour le user)
+#;<
+proc wokIntegre:RefCopy:FillUser { fshop table {force 0} {fileid stdout} {mask 644} } {
+ upvar $table TLOC
+ foreach UD [array names TLOC] {
+ set lsf $TLOC($UD)
+ set dirsrc [lindex $lsf 0]
+ puts $fileid "cd $dirsrc"
+ set root [wokIntegre:BASE:GetRootName $fshop]/$UD
+ set i [llength $lsf]
+ while { $i > 1 } {
+ set i [expr $i-1]
+ set elm [lindex $lsf $i]
+ set vrs [lindex $elm 1]
+ set file [lindex $elm 0]
+ if { [string compare $vrs x.x] != 0 } {
+ if [file exists $dirsrc/$file] {
+ if { $force } {
+ if { [file writable $dirsrc/$file] } {
+ frename $dirsrc/$file $dirsrc/${file}-sav
+ msgprint -c WOKVC -i "File $dirsrc/$file renamed ${file}-sav"
+ set Sfile $root/[wokIntegre:BASE:ftos $file $vrs]
+ wokIntegre:BASE:GetFile $Sfile $vrs $fileid
+ puts $fileid [format "chmod %s %s" $mask $dirsrc/$file]
+ } else {
+ msgprint -c WOKVC -e "File $dirsrc/$file is not writable. Cannot be overwritten."
+ return -1
+ }
+ } else {
+ msgprint -c WOKVC -e "File $dirsrc/$file already exists. Not overwritten."
+ }
+ } else {
+ set Sfile $root/[wokIntegre:BASE:ftos $file $vrs]
+ wokIntegre:BASE:GetFile $Sfile $vrs $fileid
+ puts $fileid [format "chmod %s %s" $mask $dirsrc/$file]
+ }
+ }
+ }
+ }
+ return
+}
+#;>
+# Retourne le nom du ou des workbench qu'il faut alimenter apres l'integration
+# Valeur d'un param si il existe sinon workbench racine de l'ilot
+#
+#;<
+proc wokIntegre:RefCopy:GetWB { fshop } {
+ if { [wokparam -t %VC_WBROOT $fshop] == 0 } {
+ foreach wb [sinfo -w $fshop] {
+ if [expr { ( [llength [w_info -A ${fshop}:${wb}]] > 1 ) ? 0 : 1 }] {
+ return $wb
+ }
+ }
+ return {}
+ } else {
+ return [wokparam -e %VC_WBROOT $fshop]
+ }
+}
+#
+# ((((((((((((((((VERSION))))))))))))))))
+#
+#;>
+# Retourne le path du fichier version.sccs, si create = 1 le cree s'il n'existe pas.
+#;<
+proc wokIntegre:Version:GetTableName { fshop {create 0} } {
+ set diradm [wokparam -e %VC_ROOT $fshop]/adm/version.sccs
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating versions file in [file dirname $diradm]"
+ catch { mkdir -path [file dirname $diradm] }
+ wokUtils:FILES:ListToFile {} $diradm
+ chmod 0777 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# Retourne la liste des ilots et leur numero associe.
+#;<
+proc wokIntegre:Version:Dump { fshop } {
+ return [wokUtils:FILES:FileToList [wokIntegre:Version:GetTableName $fshop]]
+}
+#;>
+# Retourne le numero de version associe a l'ilot <shop> {} sinon
+#;<
+proc wokIntegre:Version:Get { fshop } {
+ set f [wokIntegre:Version:GetTableName $fshop]
+ if { $f != {} } {
+ set str [wokinfo -n [wokinfo -s $fshop]]
+ foreach e [wokUtils:FILES:FileToList $f] {
+ if { $str == [lindex $e 0] } {
+ return [lindex $e 1]
+ }
+ }
+ }
+ return {}
+}
+#;>
+# Ecrit dans version.sccs le numero de version <ver> associe a shop
+#;<
+proc wokIntegre:Version:Put { fshop ver } {
+ set f [wokIntegre:Version:GetTableName $fshop]
+ set l [wokUtils:FILES:FileToList $f]
+ set str [wokinfo -n [wokinfo -s $fshop]]
+ if { [lsearch $l [list $str $ver]] == -1 } {
+ msgprint -c WOKVC -i "Registering the shop $str with version number $ver"
+ lappend l [list $str $ver]
+ wokUtils:FILES:copy $f ${f}-previous
+ wokUtils:FILES:ListToFile $l $f
+ }
+ return $ver
+}
+#;>
+# retourne un entier utilisable pour initialiser un nouvel ilot
+#;<
+proc wokIntegre:Version:Next { fshop } {
+ set mx 0
+ foreach e [wokUtils:FILES:FileToList [wokIntegre:Version:GetTableName $fshop]] {
+ set n [lindex $e 1]
+ set mx [expr ( $mx > $n ) ? $mx : $n]
+ }
+ return [incr mx]
+}
+#
+# ((((((((((((((((COMPTEUR-INTEGRATIONS))))))))))))))))
+#
+#;>
+# Retourne le nom du fichier contenant le compteur d'integration
+#;<
+proc wokIntegre:Number:GetName { fshop } {
+ return [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/report.num
+}
+#;>
+# Retourne le numero de l'integration suivante (celle a faire dans shop )
+# Si Setup = 1 , met le compteur a 1
+#;<
+proc wokIntegre:Number:Get { fshop {Setup 0} } {
+ set diradm [wokIntegre:Number:GetName $fshop]
+ if [file exists $diradm] {
+ return [wokUtils:FILES:FileToList $diradm]
+ } else {
+ if { $Setup } {
+ msgprint -c WOKVC -i "Creating file $diradm"
+ catch { mkdir -path [file dirname $diradm] }
+ wokUtils:FILES:ListToFile 1 $diradm
+ chmod 0777 $diradm
+ return 1
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# Ecrit number comme numero de l'integration suivante
+#;<
+proc wokIntegre:Number:Put { fshop number } {
+ set diradm [wokIntegre:Number:GetName $fshop]
+ if [file exists $diradm] {
+ wokUtils:FILES:ListToFile $number $diradm
+ return $number
+ } else {
+ return {}
+ }
+}
+#;>
+# Incremente le numero de l'integration
+#;<
+proc wokIntegre:Number:Incr { fshop } {
+ set diradm [wokIntegre:Number:GetName $fshop]
+ if [file exists $diradm] {
+ set n [wokUtils:FILES:FileToList $diradm]
+ return [incr n]
+ } else {
+ return {}
+ }
+}
+
+#############################################################################
+#
+# W G E T
+# _______
+#
+#############################################################################
+#
+# Usage
+#
+proc wokGetUsage { } {
+ puts stderr \
+ {
+ Usage:
+
+ wget [-f] [-ud <udname>] <filename> [-v <version>]
+ wget [-f] [-ud <udname>] <filename_1> ... <filename_N>
+ wget [-f] -r <reportname>
+
+ -ud : Keyword used to specify a unit name
+
+ -f : Force files to be overwritten if they already exist.
+
+ wget -l : List "gettable" files for the current unit (default)
+
+ }
+ return
+}
+
+
+#
+# Point d'entree de la commande
+#
+proc wget { args } {
+
+ ;# Options
+ ;#
+ set tblreq(-h) {}
+ set tblreq(-l) {}
+ set tblreq(-f) {}
+ set tblreq(-V) {}
+ set tblreq(-v) value_required:string
+ set tblreq(-ud) value_required:string
+ set tblreq(-r) value_required:string
+ set tblreq(-ws) value_required:string
+ set tblreq(-root) value_required:string
+ set tblreq(-from) value_required:string
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokGetUsage $args] == -1 } return
+
+ set VERBOSE [info exists tabarg(-V)]
+
+ if { $VERBOSE } {
+ puts "param = $param"
+ catch {parray tabarg}
+ }
+
+
+ if { [info exists tabarg(-h)] } {
+ wokGetUsage
+ return
+ }
+
+ if [info exists tabarg(-ws)] {
+ set fshop $tabarg(-ws)
+ } else {
+ set fshop [wokinfo -s [wokcd]]
+ }
+
+
+ ;# name of target workbench
+ ;#
+ if [info exists tabarg(-root)] {
+ set workbench $tabarg(-root)
+ } else {
+ set workbench [wokinfo -n [wokinfo -w [wokcd]]]
+ }
+
+
+ ;#puts "fshop = $fshop workbench = $workbench"
+
+ ;# name of source workbench from where the source file are to be copied.
+ ;# only used in NOBASE case.
+ ;#
+ if [info exists tabarg(-from)] {
+ set fromwb $tabarg(-from)
+ } else {
+ set fromwb [wokIntegre:RefCopy:GetWB $fshop]
+ }
+
+
+ if [info exists tabarg(-ud)] {
+ set ud $tabarg(-ud)
+ } else {
+ set ud [Sinfo -u]
+ }
+
+ set forced [info exists tabarg(-f)]
+
+ if [info exists tabarg(-v)] {
+ set version $tabarg(-v)
+ } else {
+ catch {unset version}
+ }
+
+ if [info exists tabarg(-l)] {
+ set listbase 1
+ } else {
+ catch {unset listbase}
+ }
+
+ if [info exists tabarg(-r)] {
+ set ID $tabarg(-r)
+ } else {
+ catch {unset ID }
+ }
+
+ if { [set BTYPE [wokIntegre:BASE:InitFunc $fshop]] == {} } {
+ return -1
+ }
+
+ if { "$BTYPE" == "ClearCase" } {
+ wokGetClearCase
+ return
+ }
+
+ ;#
+ ;# Autre : SCCS, RCS, NOBASE, SIMPLE geree par WOK
+ ;#
+
+ set broot [wokIntegre:BASE:GetRootName $fshop]
+ if { $broot == {} } {
+ msgprint -c WOKVC -e "The repository does not exists."
+ wokIntegre:BASE:GetType $fshop 1
+ return -1
+ }
+
+ if { "$BTYPE" == "NOBASE" } {
+ wokGetnobase
+ } else {
+ wokGetbase
+ }
+ return
+}
+;#
+;#
+;#
+proc wokGetbase { } {
+ uplevel {
+ set actv [wokIntegre:Version:Get $fshop]
+ if { $actv == {} } {
+ msgprint -c WOKVC -e "The workshop $fshop has no entry in the repository."
+ return -1
+ }
+
+ if [info exists version] {
+ set vrs $version
+ } else {
+ set vrs last:${actv}
+ }
+
+ if { $VERBOSE } { msgprint -c WOKVC -i "Checking out version : $vrs" }
+
+ set listfileinbase [wokIntegre:BASE:List $fshop $ud $actv]
+
+ if [info exists listbase] {
+ set laff [wokUtils:LIST:GM $listfileinbase $param]
+ foreach f $laff {
+ puts $f
+ }
+ return
+ }
+
+ if [info exists ID] {
+ wokIntegre:Journal:Assemble /tmp/jnltmp $fshop
+ if [regexp {^[0-9]+$} $ID] {
+ wokIntegre:Journal:PickReport /tmp/jnltmp table notes $ID
+ } else {
+ puts "Not yet implemented"
+ ;#set res [wokIntegre:Journal:PickMultReport /tmp/jnltmp $ID $ID]
+ ;#puts $res
+ }
+ catch { unlink /tmp/jnltmp }
+ } else {
+ if { $param == {} } {
+ foreach f $listfileinbase {
+ puts $f
+ }
+ return
+ }
+ if { [set RES [wokUtils:LIST:GM $listfileinbase $param]] == {} } {
+ msgprint -c WOKVC -e "No match for $param in unit $ud."
+ }
+
+ if { [info exists version] && [llength $RES] > 1 } {
+ msgprint -c WOKVC -e "Option -v should be used with only one file to check out. Not done"
+ return
+ }
+
+ set locud [woklocate -u $ud ${fshop}:${workbench}]
+ if { $locud != {} } {
+ set table(${ud}.[uinfo -c $locud]) [wokUtils:LIST:pair $RES $vrs 2]
+ } else {
+ msgprint -c WOKVC -e "Unit $ud not found. Cannot create a new one (Unknown type)."
+ return -1
+ }
+ }
+
+ if { [wokIntegre:RefCopy:Writable $fshop table $workbench] == -1 } {
+ return -1
+ }
+ wokIntegre:RefCopy:GetPathes $fshop table $workbench
+
+ if { [llength [w_info -A ${fshop}:$workbench]] == 1 } {
+ msgprint -c WOKVC -w "You are working in the reference area."
+ wokIntegre:RefCopy:SetWritable table [id user]
+ set forced 1
+ }
+
+ if { [wokUtils:FILES:dirtmp [set dirtmp /tmp/wintegrecreateunits[id process]]] == -1 } {
+ msgprint -c WOKVC -e "Unable to create working directory"
+ return -1
+ }
+
+ set chkout $dirtmp/checkout.cmd
+ set chkid [open $chkout w]
+ wokIntegre:RefCopy:FillUser $fshop table $forced $chkid
+ wokIntegre:BASE:EOF $chkid
+ close $chkid
+
+ if { $VERBOSE } {
+ msgprint -c WOKVC -i "Send the following script:"
+ puts [exec cat $dirtmp/checkout.cmd]
+ }
+
+ set statx [wokIntegre:BASE:Execute $VERBOSE $chkout]
+ if { $statx != 1 } {
+ msgprint -c WOKVC -e "Error during checkout(Get)."
+ msgprint -c WOKVC -e "The following script was sent to perform check-out"
+ puts [exec cat $dirtmp/checkout.cmd]
+ }
+
+ unlink $chkout
+ rmdir -nocomplain $dirtmp
+ return $statx
+ }
+}
+;#
+;#
+;#
+proc wokGetnobase { } {
+ uplevel {
+ if [wokUtils:WB:IsRoot $workbench] {
+ msgprint -c WOKVC -e "You are working in the reference area. Use chmod and edit the file..."
+ return -1
+ }
+
+ if [info exists version] {
+ msgprint -c WOKVC -w "Value $version for option -v ignored in this context (NOBASE)."
+ }
+
+ set listfileinbase [wokIntegre:BASE:List $fshop $ud {}]
+
+ if [info exists listbase] {
+ set laff [wokUtils:LIST:GM $listfileinbase $param]
+ foreach f $laff {
+ puts $f
+ }
+ return
+ }
+
+ if [info exists ID] {
+ msgprint -c WOKVC -w "Value $ID for option -r ignored in this context (NOBASE)."
+ return
+ } else {
+ if { $param == {} } {
+ foreach f $listfileinbase {
+ puts $f
+ }
+ return
+ }
+ if { [set RES [wokUtils:LIST:GM $listfileinbase $param]] == {} } {
+ msgprint -c WOKVC -e "No match for $param in unit $ud."
+ }
+ set locud [woklocate -u $ud]
+ if { $locud != {} } {
+ set table(${ud}.[uinfo -c $locud]) $RES
+ } else {
+ msgprint -c WOKVC -e "Unit $ud not found. Unknown type for creation."
+ return -1
+ }
+ }
+
+ foreach UD [array names table] {
+ regexp {(.*)\.(.*)} $UD ignore name type
+ if { [lsearch [w_info -l $workbench] $name ] == -1 } {
+ ;# if workbench is writable ..
+ msgprint -c WOKVC -i "Creating unit ${workbench}:${name}"
+ ucreate -$type ${workbench}:${name}
+ }
+ set dirsrc [wokinfo -p source:. ${workbench}:${name}]
+ if ![file writable $dirsrc] {
+ msgprint -c WOKVC -e "You cannot write in directory $dirsrc"
+ return -1
+ }
+ set fromsrc [wokinfo -p source:. ${fromwb}:${name}]
+ set table($UD) [list $fromsrc $dirsrc $table($UD)]
+ }
+ foreach UD [array names table] {
+ set from [lindex $table($UD) 0]
+ set dest [lindex $table($UD) 1]
+ foreach file [lindex $table($UD) 2] {
+ if [file exists $dest/$file] {
+ if { $forced } {
+ if { [file writable $dest/$file] } {
+ frename $dest/$file $dest/${file}-sav
+ msgprint -c WOKVC -i "File $dest/$file renamed ${file}-sav"
+ wokUtils:FILES:copy $from/$file $dest/$file
+ chmod 0644 $dest/$file
+ } else {
+ msgprint -c WOKVC -e "File $dest/$file is not writable. Cannot be overwritten."
+ return -1
+ }
+ } else {
+ msgprint -c WOKVC -e "File $dest/$file already exists. Not overwritten."
+ }
+ } else {
+ wokUtils:FILES:copy $from/$file $dest/$file
+ chmod 0644 $dest/$file
+ }
+ }
+ }
+ }
+ return
+}
+#
+# Base ClearCase
+#
+proc wokGetClearCase { } {
+ uplevel {
+ ;#puts "wget pour clearcase:"
+ ;# workbench racine de l'ilot ??
+ foreach wb [sinfo -w $shop] {
+ if {[wokUtils:WB:IsRoot $wb]} {
+ set root $wb
+ break
+ }
+ }
+
+ set listfileinbase [wokUtils:FILES:ls [wokinfo -p source:. ${root}:${ud}]]
+
+ if [info exists listbase] {
+ set laff [wokUtils:LIST:GM $listfileinbase $param]
+ foreach f $laff {
+ puts $f
+ }
+ return
+ }
+
+ if [info exists ID] {
+ msgprint -c WOKVC -w "Value $ID for option -r ignored in this context (NOBASE)."
+ return
+ } else {
+ if { $param == {} } {
+ foreach f $listfileinbase {
+ puts $f
+ }
+ return
+ }
+ if { [set RES [wokUtils:LIST:GM $listfileinbase $param]] == {} } {
+ msgprint -c WOKVC -e "No match for $param in unit $ud."
+ }
+ set locud [woklocate -u $ud]
+ if { $locud != {} } {
+ set table(${ud}.[uinfo -c $locud]) $RES
+ } else {
+ msgprint -c WOKVC -e "Unit $ud not found. Unknown type for creation."
+ return -1
+ }
+ }
+
+ foreach UD [array names table] {
+ regexp {(.*)\.(.*)} $UD ignore name type
+ if { [lsearch [w_info -l $workbench] $name ] == -1 } {
+ ;# if workbench is writable ..
+ msgprint -c WOKVC -i "Creating unit ${workbench}:${name}"
+ ucreate -$type ${workbench}:${name}
+ }
+ set dirsrc [wokinfo -p source:. ${workbench}:${name}]
+ if ![file writable $dirsrc] {
+ msgprint -c WOKVC -e "You cannot write in directory $dirsrc"
+ return -1
+ }
+
+ set fromsrc [wokIntegre:BASE:GetVOBName [Sinfo -f] $shop $wb ${name}]
+ set table($UD) [list $fromsrc $dirsrc $table($UD)]
+ }
+
+ ;#parray table
+ ;# VOB ?? directory arrivee
+ ;#table(WOKTclLib.r) =
+ ;#/adv_23/WOK/k2dev/ref/src/WOKTclLib/. /adv_23/WOK/k2dev/iwok2/src/WOKTclLib/. upack.tcl
+
+ foreach UD [array names table] {
+ set from [lindex $table($UD) 0]
+ set dest [lindex $table($UD) 1]
+ foreach file [lindex $table($UD) 2] {
+ if [file exists $dest/$file] {
+ if { $forced } {
+ if { [file writable $dest/$file] } {
+ frename $dest/$file $dest/${file}-sav
+ msgprint -c WOKVC -i "File $dest/$file renamed ${file}-sav"
+ wokUtils:FILES:copy $from/$file $dest/$file
+ chmod 0644 $dest/$file
+ } else {
+ msgprint -c WOKVC -e "File $dest/$file is not writable. Cannot be overwritten."
+ return -1
+ }
+ } else {
+ msgprint -c WOKVC -e "File $dest/$file already exists. Not overwritten."
+ }
+ } else {
+ wokUtils:FILES:copy $from/$file $dest/$file
+ chmod 0644 $dest/$file
+ }
+ }
+ }
+ }
+
+ return
+}
+#############################################################################
+#
+# W P U T
+# _______
+#
+#############################################################################
+#
+# Usage
+#
+proc wokPutUsage { } {
+ return
+}
+
+proc wput { args } {
+ puts "No longer supported."
+ return
+}
--- /dev/null
+#========================================================================================================\r
+# p-put Version 3.02 beta (egu 17/07/98 )\r
+# ajout verification que les fichiers embarques ne sont pas protege en ecriture sous WNT\r
+#========================================================================================================\r
+\r
+# \r
+# Usage\r
+# \r
+proc p-putUsage { } {\r
+ puts stdout {p-put Version 3.02 17/07/98}\r
+ puts stdout {Usage : p-put [-h] (this help)}\r
+ puts stdout {Usage : p-put [-web] (updating web site)}\r
+ puts stdout {Usage : p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> } \r
+ #puts stdout { p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> [-P <patch>] }\r
+ puts stdout { p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> [-P <patch>] -L <liste-patch> -C "comment" }\r
+ return\r
+}\r
+\r
+proc p-put { args } {\r
+ global env\r
+\r
+ set tblreq(-h) {}\r
+ set tblreq(-web) {}\r
+ set tblreq(-B) value_required:string\r
+ set tblreq(-U) value_required:string\r
+ set tblreq(-P) value_required:string\r
+ set tblreq(-L) value_required:string\r
+ set tblreq(-C) value_required:string\r
+\r
+ set param {}\r
+ if { [putils:EASY:GETOPT param tabarg tblreq p-putUsage $args] == -1 } return\r
+\r
+#==================== OPTIONS SETTINGS ==========================\r
+\r
+ if [info exists tabarg(-web)] {\r
+ update-web-data\r
+ return\r
+ }\r
+\r
+ if [info exists tabarg(-h)] {\r
+ p-putUsage\r
+ return\r
+ }\r
+\r
+ set param_length [llength $param]\r
+\r
+ if { $param_length == 0 } {\r
+ puts stderr "Error : You must enter at least one configuration"\r
+ return error\r
+ } else {\r
+ set list_config {}\r
+ foreach config $param {\r
+ lappend list_config $config\r
+ }\r
+ }\r
+\r
+ ### ABOUT UL ###\r
+\r
+ set nbargx 0\r
+ if [info exists tabarg(-B)] {\r
+ set SRC_BAG_PATH $tabarg(-B)\r
+ if ![file exists $SRC_BAG_PATH] { \r
+ puts stderr " Error : can not see $SRC_BAG_PATH"\r
+ return error\r
+ }\r
+ incr nbargx\r
+ }\r
+\r
+ if [info exists tabarg(-U)] {\r
+ set SRC_BAG_DIR $tabarg(-U)\r
+ set SRC_DIR ${SRC_BAG_PATH}/${SRC_BAG_DIR}\r
+ if ![file exists ${SRC_DIR}] { \r
+ puts stderr " Error : can not see $SRC_BAG_DIR directory under $SRC_BAG_PATH"\r
+ return error\r
+ }\r
+ incr nbargx\r
+ }\r
+\r
+ if [info exists tabarg(-P)] {\r
+ set PATCH $tabarg(-P)\r
+ set AUTONUM 0\r
+ } else {\r
+ set PATCH {}\r
+ set AUTONUM 1\r
+ }\r
+\r
+ ### ABOUT PATCH ###\r
+\r
+ set nbargy 0\r
+\r
+ if [info exists tabarg(-C)] {\r
+ set COMMENT $tabarg(-C)\r
+ incr nbargy\r
+ }\r
+ \r
+ \r
+ if [info exists tabarg(-L)] {\r
+ set LIST_FILE $tabarg(-L)\r
+ if ![file readable $LIST_FILE] { \r
+ puts stderr " Error : can not read $LIST_FILE"\r
+ return\r
+ } else {\r
+ set f [open $LIST_FILE r]\r
+ set PB 0\r
+ while { [ gets $f line ] >= 0 } {\r
+ if ![catch { glob ${SRC_DIR}/${line} } ] {\r
+ foreach fich [glob ${SRC_DIR}/${line}] {\r
+ if ![file readable $fich] {\r
+ puts stderr " Error : can not read $fich"\r
+ set PB 1\r
+ } \r
+ } \r
+ if { $env(WOKSTATION) == "wnt"} {\r
+ foreach fich [glob ${SRC_DIR}/${line}] {\r
+ if ![file writable $fich] {\r
+ puts stderr " Error : $fich not writable, problem will exist for next patch"\r
+ set PB 1\r
+ }\r
+ }\r
+ }\r
+ } else {\r
+ puts stderr " Error : can not glob line ${SRC_DIR}/${line}"\r
+ set PB 1\r
+ }\r
+ }\r
+ close $f\r
+ if { $PB == 1 } { \r
+ puts stderr " Procedure aborted " \r
+ return 0\r
+ }\r
+ }\r
+ incr nbargy\r
+ } else {\r
+ foreach fich [recursive_glob ${SRC_DIR} *] {\r
+ if ![file readable $fich] {\r
+ puts stderr " Error : can not read $fich"\r
+ return\r
+ }\r
+ }\r
+ if { $env(WOKSTATION) == "wnt"} {\r
+ foreach fich [recursive_glob ${SRC_DIR} *] {\r
+ if ![file writable $fich] {\r
+ puts stderr " Error : $fich not writable, problem will exist for next patch"\r
+ return\r
+ }\r
+ }\r
+ }\r
+ }\r
+\r
+ ### REFERENCE ###\r
+\r
+ set ULBAG [wokparam -e %BAG_Home REFERENCE]\r
+\r
+ ### LETS GO ###\r
+ \r
+ if [expr {$nbargx == 2 && $nbargy == 0}] {\r
+ if {[put-ul $SRC_BAG_PATH $SRC_BAG_DIR $ULBAG $list_config] == 1 } { return end }\r
+ return error\r
+ }\r
+\r
+ if [expr { $nbargx == 2 && $nbargy == 2}] {\r
+ if {[put-patch $SRC_BAG_PATH $SRC_BAG_DIR $AUTONUM $PATCH $ULBAG $LIST_FILE $COMMENT $list_config] == 1 } { return end }\r
+ return error\r
+ } \r
+ \r
+}\r
+\r
+##################### PUT-UL ######################################\r
+\r
+proc put-ul { src_bag ul_name dest_dir config_list} {\r
+ \r
+ \r
+ if [file exists ${dest_dir}/${ul_name}.tar.gz] {\r
+ puts stderr "Error : ${ul_name}.tar.gz already exist in ${dest_dir}"\r
+ return 0\r
+ }\r
+ \r
+ set savpwd [pwd]\r
+ cd ${src_bag}/${ul_name} \r
+\r
+ puts stdout "Info : Creating ${dest_dir}/${ul_name}.tar"\r
+ \r
+ if { [putils:EASY:tar tarfromroot ${dest_dir}/${ul_name}.tar .] == -1 } {\r
+ puts stderr "Error while creating ${dest_dir}/{ul_name}.tar "\r
+ catch {unlink ${dest_dir}/${ul_name}.tar}\r
+ cd $savpwd\r
+ return 0\r
+ } \r
+ \r
+ puts stdout "Info : Gziping ${dest_dir}/${ul_name}.tar"\r
+ \r
+ if { [putils:FILES:compress ${dest_dir}/${ul_name}.tar] == -1 } {\r
+ puts stderr "Error while creating ${dest_dir}/${ul_name}.tar.gz\r
+ catch {unlink ${dest_dir}/${ul_name}.tar}\r
+ catch {unlink ${dest_dir}/${ul_name}.tar.gz}\r
+ cd $savpwd\r
+ return 0\r
+ }\r
+\r
+ #### Construction du fichier de trace ####\r
+ puts stdout "Info : Creating trace file ${dest_dir}/TRC/${ul_name}.trc"\r
+ set trace [open ${dest_dir}/TRC/${ul_name}.trc w]\r
+ foreach fich [glob ${src_bag}/${ul_name}/*] {\r
+ puts $trace $fich\r
+ }\r
+ close $trace\r
+\r
+ #### Inscription dans le(s) configul(s) ####\r
+ set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"]\r
+ foreach config $config_list {\r
+ set CONFIGUL ${dest_dir}/CONFIGUL.${config}\r
+ puts stdout " Updating $CONFIGUL"\r
+ set f [ open $CONFIGUL a+]\r
+ set s [format "%-18s %s" $ul_name $now]\r
+ puts $f $s\r
+ close $f\r
+ }\r
+\r
+ ###fin\r
+ puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
+ cd $savpwd\r
+\r
+\r
+ #### mise a jour des fichiers du web #### \r
+ update-web-data\r
+\r
+ return 1 \r
+}\r
+\r
+\r
+#\r
+##################### PUT-PATCH ######################################\r
+#\r
+\r
+proc put-patch { src_bag ul_name AUTONUM patch_name dest_bag lst_patch comment config_list} {\r
+ \r
+ set dest_dir $dest_bag/PATCH\r
+\r
+ ### Pour la numerotation automatique ###\r
+ if { $AUTONUM} {\r
+ set level [conf_ul_level $ul_name [lindex $config_list 0] $dest_bag]\r
+ foreach config $config_list {\r
+ if ![ file exists ${dest_dir}/PATCHISTO.${config} ] {\r
+ puts stderr "Error autonum: File ${dest_dir}/PATCHISTO.${config} dont exist, you must create it"\r
+ return 0\r
+ }\r
+ set new_level [conf_ul_level $ul_name $config $dest_bag]\r
+ if { $new_level != $level } {\r
+ puts stderr " Error autonum : different patch levels in different configul "\r
+ return 0\r
+ }\r
+ }\r
+ \r
+ \r
+ if { $level == -1 } { \r
+ puts stderr " Error : can't calculate patch levels "\r
+ return 0\r
+ }\r
+ incr level\r
+ set patch_name ${ul_name}_${level}\r
+ puts stdout "Info : patch auto numerotation = $level"\r
+ }\r
+\r
+ #####\r
+\r
+ set savpwd [pwd]\r
+ cd ${src_bag}/${ul_name}\r
+ \r
+ if [file exists ${dest_dir}/${patch_name}.tar.gz ] {\r
+ puts stderr "Error : File ${dest_dir}/${patch_name}.tar.gz already exists. Nothing done"\r
+ cd $savpwd\r
+ return 0\r
+ }\r
+\r
+ puts stdout "Info : Creating ${dest_dir}/${patch_name}.tar"\r
+ \r
+if { [putils:EASY:tar tarfromliste ${dest_dir}/${patch_name}.tar ${lst_patch}] == -1 } {\r
+ puts stderr "Error while creating ${dest_dir}/{patch_name}.tar "\r
+ catch {unlink ${dest_dir}/{patch_name}.tar }\r
+ cd $savpwd\r
+ return 0\r
+ } \r
+ \r
+ puts stdout "Info : Gziping ${dest_dir}/${patch_name}.tar"\r
+ if { [putils:FILES:compress ${dest_dir}/${patch_name}.tar] == -1 } {\r
+ puts stderr "Error while creating ${dest_dir}/${patch_name}.tar.gz\r
+ catch {unlink ${dest_dir}/${patch_name}.tar}\r
+ catch {unlink ${dest_dir}/${patch_name}.tar.gz}\r
+ cd $savpwd\r
+ return 0\r
+ }\r
+\r
+ puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
+ \r
+ #### Construction du fichier de trace ####\r
+ puts stdout "Info : Creating trace file ${dest_dir}/TRC/${patch_name}.trc"\r
+ set f [open $lst_patch r]\r
+ set trace [open ${dest_dir}/TRC/${patch_name}.trc w]\r
+ while { [ gets $f line ] >= 0 } {\r
+ foreach fich [glob ${src_bag}/${ul_name}/${line}] {\r
+ puts $trace $fich\r
+ }\r
+ }\r
+ close $f\r
+ close $trace\r
+ \r
+ #### Inscription dans le(s) patchisto(s) ####\r
+ \r
+ #set now [string range [fmtclock [getclock]] 0 18]\r
+ set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"]\r
+ set level [lindex [split ${patch_name} _] end]\r
+ set ul_name [lindex [split ${patch_name} _] 0]\r
+ foreach config $config_list {\r
+ set PATCHISTO "${dest_dir}/PATCHISTO.${config}"\r
+ puts stdout "Info : updating $PATCHISTO"\r
+ set f [open $PATCHISTO r+]\r
+ set indice 0\r
+ while { [ gets $f line ] >= 0 } {\r
+ if [ ctype alnum [ lindex $line 0 ] ] {\r
+ set indice [ lindex $line 0 ]\r
+ }\r
+ }\r
+ incr indice\r
+ puts stdout "Info : $PATCHISTO patch indice = $indice"\r
+ close $f\r
+ set lpatch [putils:FILES:FileToList $PATCHISTO ]\r
+ set s [format "%-5s%-18s%3s %-5s %s" $indice $ul_name $level $now $comment]\r
+ lappend lpatch $s\r
+ putils:FILES:ListToFile $lpatch $PATCHISTO\r
+ }\r
+\r
+ ###FIN\r
+ puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
+ cd $savpwd\r
+\r
+ #### mise a jour des fichiers du web #### \r
+ update-web-data\r
+\r
+ return 1 \r
+}\r
+\r
+#=================================================================================\r
+proc conf_ul_level { ul_name config bag_path } {\r
+\r
+ set CONFIGUL ${bag_path}/CONFIGUL.${config}\r
+ set PATCHISTO ${bag_path}/PATCH/PATCHISTO.${config}\r
+\r
+ set level -1\r
+ if [file exists ${CONFIGUL} ] { \r
+ set f [open $CONFIGUL r ]\r
+ while {[gets $f line] >= 0 } {\r
+ if [ctype alnum [ cindex [lindex $line 0] 0 ] ] {\r
+ if { [lindex $line 0] == $ul_name } {\r
+ set level 0\r
+ }\r
+ }\r
+ }\r
+ close $f\r
+ }\r
+ \r
+ if [file exists ${PATCHISTO}] { \r
+ set f [open $PATCHISTO r]\r
+ while { [ gets $f line ] >= 0 } {\r
+ if [ ctype alnum [ lindex $line 0 ] ] {\r
+ if { [lindex $line 1] == $ul_name } {\r
+ set level [lindex $line 2]\r
+ }\r
+ }\r
+ }\r
+ close $f\r
+ }\r
+ return $level\r
+}\r
+\r
+#################################################\r
+proc update-web-data { } {\r
+\r
+ global env \r
+ set PROCFTPPATH $env(FACTORYHOME)/MajWeb\r
+ puts -nonewline "=== Updating www data....."\r
+\r
+ if { $env(WOKSTATION) == "wnt"} {\r
+ if [file exists $PROCFTPPATH/putdata.ftp] { \r
+ if [catch { eval exec ftp {-v -i -s:$PROCFTPPATH/putdata.ftp} } status] {\r
+ puts stderr $status\r
+ } else {\r
+ puts " done ==="\r
+ }\r
+ } else {\r
+ puts stdout "Info : Cant find $PROCFTPPATH/putdata.ftp"\r
+ }\r
+ } else {\r
+ if [file exists $PROCFTPPATH/putdata.com] { \r
+ if [catch { eval exec $PROCFTPPATH/putdata.com } status] {\r
+ puts stderr $status\r
+ } else {\r
+ puts " done ==="\r
+ }\r
+ } else {\r
+ puts stdout "Info : Cant find $PROCFTPPATH/putdat.ftp"\r
+ }\r
+ }\r
+return\r
+}\r
+\r
+#========================================================================================================\r
+# p-get Version 3.04 (egu 29/09/98 )\r
+# ajout de l'option -f pour forcer l'install des patch\r
+# (ajout de l'option -runtime pour ne pas faire de declarations\r
+# liees a la descente des patchs)activite non visible\r
+# Modification de nombreuses functions pour wok: wok n'est plus versionne\r
+# suppression des options -v (verbose) et -n (no execute)\r
+#========================================================================================================\r
+#========================================================================================================\r
+#========================================================================================================\r
+\r
+proc p-get-usage { } {\r
+ puts stderr {}\r
+ puts stdout {p-get Version 3.04 (september 98)}\r
+ #puts stderr {Usage : p-get [-h][-f][-rt][-clean][-d dirinstall] <conf> [del list] [-P patch |-I indice]}\r
+ puts stderr {Usage : p-get [-h][-f][-clean][-d dirinstall] <conf> [del list] [-P patch |-I indice]}\r
+ puts stderr { -h : this help}\r
+ puts stderr { -f : force install}\r
+# puts stderr { -rt : runtime mode} #fonctionne mais volontairement cache\r
+ puts stderr { -clean : clean mode}\r
+ puts stderr { [-d dirinstall] : directory to install ul}\r
+ puts stderr { <conf> : configuration}\r
+ puts stderr { [del list] : list of one or more Delivery: [ <del1> [del2] [del3] ... ]}\r
+ puts stderr { OR "ALL" ("ALL" is default value)}\r
+ puts stderr { [-P patch | : patch number OR "ALL" ("ALL" is default value)}\r
+ puts stderr { |-I indice] : indice number OR "ALL" ("ALL" is default value)}\r
+# puts stderr { Online doc at http://info.paris1.matra-dtv.fr/Devlog/Departements/Dcfao/env/pget304.htm}\r
+ return\r
+}\r
+\r
+#========================================================================================================\r
+\r
+proc p-get { args } {\r
+ \r
+ global env\r
+ \r
+ set tblreq(-h) {}\r
+ set tblreq(-f) {}\r
+ set tblreq(-rt) {}\r
+ set tblreq(-clean) {}\r
+ set tblreq(-d) value_required:string\r
+ set tblreq(-P) value_required:string\r
+ set tblreq(-I) value_required:string\r
+ \r
+ set param {}\r
+ if { [putils:EASY:GETOPT param tabarg tblreq p-get-usage $args] == -1 } return\r
+ set param_length [llength $param]\r
+ \r
+ #======================================= VARIABLES SETTINGS =============================================\r
+ if [info exists tabarg(-h)] {\r
+ p-get-usage\r
+ return\r
+ }\r
+ \r
+ #----------- WOK SETTINGS ------------------------------------- \r
+ wokclose -a [wokparam -e %[finfo]_Home]\r
+ set SRCBAGPATH [wokparam -e %BAG_Home REFERENCE]\r
+ set SRCPATCHPATH $SRCBAGPATH/PATCH\r
+ set DESTBAGPATH [wokparam -e %BAG_Home]\r
+\r
+ #------------- OPTIONS SETTINGS -------------------------------\r
+ set FORCE [info exists tabarg(-f)]\r
+ set RUNTIME [info exists tabarg(-rt)]\r
+ set CLEAN [info exists tabarg(-clean)]\r
+\r
+ if [info exists tabarg(-d)] {\r
+ set NEWDIR $tabarg(-d)\r
+ } else {\r
+ set NEWDIR 0\r
+ }\r
+ \r
+ if { $param_length == 0 } {\r
+ puts stderr " Error : You must at least enter a configuration"\r
+ p-get-usage\r
+ return\r
+ }\r
+\r
+ set CONF [lindex $param 0]\r
+ set CONFIGUL ${SRCBAGPATH}/CONFIGUL.${CONF}\r
+ if { ![file exists $CONFIGUL] } {\r
+ puts stderr " Error : Cannot find $CONFIGUL, maybe version $CONF don't exist "\r
+ p-get-usage\r
+ return\r
+ }\r
+ \r
+ set PATCHISTO ${SRCPATCHPATH}/PATCHISTO.${CONF}\r
+ \r
+ set ul_list {}\r
+ if { $param_length == 1 } { lappend ul_list ALL }\r
+ if { $param_length >= 2 } {\r
+ if { [lindex $param 1] == "ALL" } { \r
+ lappend ul_list ALL \r
+ } else {\r
+ for { set i 1 } { $i < $param_length } { incr i } {\r
+ lappend ul_list [lindex $param $i]\r
+ }\r
+ }\r
+ }\r
+ \r
+ if [info exists tabarg(-P)] {\r
+ set maxlevel $tabarg(-P)\r
+ if { $maxlevel != "ALL" && [ctype digit $maxlevel] == 0 } {\r
+ puts stderr " Error : -P option must be a number or \"ALL\""\r
+ p-get-usage\r
+ return\r
+ }\r
+ } else {\r
+ set maxlevel ALL\r
+ }\r
+ \r
+ if [info exists tabarg(-I)] {\r
+ set maxindice $tabarg(-I)\r
+ if { $maxindice != "ALL" && [ctype digit $maxindice] == 0 } {\r
+ puts stderr " Error : -I option must be a number or \"ALL\""\r
+ p-get-usage\r
+ return\r
+ }\r
+ } else {\r
+ set maxindice ALL\r
+ }\r
+ \r
+ \r
+ #----------- OPTIONS RESTRICTIONS --------------------------\r
+ \r
+ if { $maxlevel != "ALL" && $maxindice != "ALL" } {\r
+ puts stderr "Error : You can't use -I and -P options together"\r
+ return\r
+ }\r
+ \r
+ if { $maxlevel != "ALL" } {\r
+ if { [llength $ul_list] > 1 || [lindex $ul_list 0] == "ALL"} {\r
+ puts stderr "Error : You can't use -P option with more than one selected UL"\r
+ return\r
+ }\r
+ }\r
+ \r
+ #-- Infos --\r
+ puts "SELECTED UL(s) : $ul_list"\r
+ puts "CONFIGURATION : $CONF"\r
+ puts "MAX PATCH LEVEL : $maxlevel"\r
+ puts "MAX INDICE LEVEL : $maxindice"\r
+ if { $NEWDIR != 0 } {\r
+ puts "INSTALLATION DIR : $NEWDIR"\r
+ } else {\r
+ puts "INSTALLATION DIR : $DESTBAGPATH"\r
+ }\r
+ if $FORCE { puts "FORCE ON" }\r
+ if $RUNTIME { puts "RUNTIME ON" }\r
+ puts {}\r
+\r
+ \r
+ #================================= LET'S GO ==============================================\r
+ #====== creating array mytab of couples (ul full name - patch level to be installed) ======\r
+\r
+ #reconstruct ul_list if "ALL" ul specified\r
+ if { [lindex $ul_list 0] == "ALL" } {\r
+ set admdir [wokparam -e %[finfo]_Adm]\r
+ set file ${admdir}/${CONF}.edl\r
+ if [file exists $file] {\r
+ wokclose -a [wokparam -e %[finfo]_Home]\r
+ set lst_conf [join [wokparam -e %${CONF}_Config] ]\r
+ if ![ catch { wokparam -e %${CONF}_Runtime } gonogo ] {\r
+ foreach a [join [wokparam -e %${CONF}_Runtime] ] { lappend lst_conf $a }\r
+ } \r
+ set ul_list {}\r
+ foreach p $lst_conf {\r
+ if { [lindex [split $p "-"] 1] != $CONF } {\r
+ puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p"\r
+ #return\r
+ } else {\r
+ lappend ul_list [lindex [split $p "-"] 0]\r
+ } \r
+ }\r
+ foreach p $lst_conf {\r
+ if { [lindex [split $p "-"] 1] != $CONF } {\r
+ puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p"\r
+ #return\r
+ } else {\r
+ lappend ul_list [lindex [split $p "-"] 0]\r
+ } \r
+ }\r
+ } else {\r
+ puts stderr "Error: None ul installed. Option ul_list = ALL can't be used"\r
+ return\r
+ }\r
+ }\r
+\r
+ #construct array from CONFIGUL file\r
+ if { [array-set-from-CONFIGUL tab $CONFIGUL $ul_list] == 0 } { return }\r
+\r
+ if { [array exists tab] == 0 } {\r
+ puts stderr "Error : none del of $CONF matching given list"\r
+ return\r
+ }\r
+\r
+ #construct array from PATCHISTO file\r
+ array-set-from-PATCHISTO tab $PATCHISTO $ul_list $maxindice $maxlevel\r
+ \r
+ #----------- Infos ----------------- \r
+ puts "***** install levels *****"\r
+ array-print tab\r
+ \r
+\r
+ #====================== Installation from array "tab" ===============================\r
+ \r
+ set lstul [ lsort [array names tab] ]\r
+ \r
+ ### set destination directory ###\r
+ if { $NEWDIR != 0 } {\r
+ foreach MYUL $lstul {\r
+ set MYDEL [lindex [split $MYUL "-"] 0]\r
+ set PARCELPATH [parcel-path $MYUL $CONF]\r
+ \r
+ #verrue wok\r
+ if { $MYDEL == "wok"} {\r
+ set pat ${DESTBAGPATH}/${MYUL}\r
+ if { $NEWDIR != $pat } {\r
+ puts stderr "Error : wok cannot be install in a special directory"\r
+ return\r
+ }\r
+ }\r
+ #fin verrue wok\r
+ \r
+ if { $PARCELPATH != 0 && $PARCELPATH != $NEWDIR } {\r
+ puts stderr "${MYDEL}-${CONF} already exist in $PARCELPATH : Cannot create same parcel in $NEWDIR"\r
+ puts stderr "Nothing done"\r
+ return\r
+ }\r
+ }\r
+ }\r
+\r
+ ### begin install from array tab ###\r
+ foreach MYUL $lstul {\r
+ if { $tab($MYUL) >= 0 } {\r
+ set MYDEL [lindex [split $MYUL "-"] 0]\r
+ \r
+ ### test for wok \r
+ if { $MYDEL == "wok"} { \r
+ set MYPARCEL ${MYUL}\r
+ set PARCELPATH ${DESTBAGPATH}/${MYPARCEL}\r
+ } else {\r
+ set MYPARCEL ${MYDEL}-${CONF}\r
+ if { $NEWDIR != 0 } {\r
+ set PARCELPATH $NEWDIR \r
+ } else {\r
+ set PARCELPATH [parcel-path $MYUL $CONF]\r
+ if { $PARCELPATH == 0 } {\r
+ set PARCELPATH ${DESTBAGPATH}/${MYPARCEL}\r
+ }\r
+ }\r
+ }\r
+ \r
+ if $FORCE { \r
+ set level_to_begin_install 0 \r
+ } else {\r
+ set installed_level [parcel-level $MYUL $CONF]\r
+ set level_to_begin_install [expr ( $installed_level + 1)]\r
+ }\r
+ \r
+ if { $level_to_begin_install > $tab($MYUL) } {\r
+ set bag_patch_level [conf_ul_level $MYUL $CONF $SRCBAGPATH]\r
+#FUN 13/10/98 \r
+ if {$installed_level > $tab($MYUL)} {\r
+ puts "\nWarning: $MYUL is already at level $installed_level > $tab($MYUL)"\r
+ } else {\r
+ puts "\n----- $MYUL is already at level $installed_level (max = $bag_patch_level)"\r
+ }\r
+ } else {\r
+ set s [format "\n----- INSTALLING %-15s\t%-3s>> %-3s in %s -----" $MYUL $level_to_begin_install $tab($MYUL) $PARCELPATH ]\r
+ puts stdout $s\r
+ }\r
+ \r
+ for { set pnumber $level_to_begin_install } { $pnumber <= $tab($MYUL) } { incr pnumber } {\r
+ puts stdout "INSTALL LEVEL $pnumber"\r
+ switch $pnumber 0 {\r
+ if { ![install-ul $MYUL $SRCBAGPATH $PARCELPATH $CONF taberror $RUNTIME $FORCE]} { break }\r
+ set pnumber [expr max(0,[parcel-level $MYUL $CONF])]\r
+ } default {\r
+ if { ![install-patch $MYUL $pnumber $SRCPATCHPATH $PARCELPATH $CONF taberror] } { break }\r
+ \r
+ }\r
+ }\r
+ \r
+ if $CLEAN {\r
+ set lst_station [join [wokparam -e %[finfo -W]_Stations] " "]\r
+ foreach station [join [wokparam -e %REFERENCE_Stations] " "] {\r
+ if {[lsearch -exact $lst_station $station] == -1} { \r
+ puts stdout " - removing $station dependent files..."\r
+ if { [file exists $PARCELPATH/$station] } { catch { exec rm -rf $PARCELPATH/$station } }\r
+ if { [file exists $PARCELPATH/tmp/$station] } { catch { exec rm -rf $PARCELPATH/tmp/$station } }\r
+ if { [file exists $PARCELPATH/.adm/$station] } { catch { exec rm -rf $PARCELPATH/.adm/$station } }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ array-print taberror\r
+ \r
+ return\r
+}\r
+\r
+#=================================================================\r
+# ARRAY-SET-FROM-CONFIGUL (egu)\r
+#\r
+# set "array_name" with couples (ul-level) get from "conf-file".\r
+# with ul matching "ul-list" element\r
+#=================================================================\r
+\r
+proc array-set-from-CONFIGUL { array_name conf_file ul_list } {\r
+\r
+ upvar $array_name tab\r
+ if [file readable $conf_file ] {\r
+ set f [open $conf_file r]\r
+ set line {}\r
+ while {[gets $f line] >= 0 } { \r
+ if { [llength $line] != 0 } { \r
+ if { [ctype alnum [cindex [lindex $line 0] 0]] == 1 } { \r
+ set ul_name [lindex $line 0]\r
+ if { [lindex $ul_list 0] == "ALL" } {\r
+ set tab($ul_name) 0\r
+ } else {\r
+ foreach ul $ul_list {\r
+ if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } {\r
+ set tab($ul_name) 0 \r
+ break\r
+ }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ close $f\r
+ } else {\r
+ puts stderr "Error : Can not read $conf_file"\r
+ return 0\r
+ }\r
+\r
+ return 1\r
+}\r
+\r
+\r
+#=================================================================\r
+# ARRAY-SET-FROM-PATCHISTO (egu)\r
+#\r
+# set "array_name" with couples (ul-level) get from "patch-file"\r
+# line of indice < max_i\r
+# with ul matching "ul-list" element \r
+# with level < max_p\r
+#=================================================================\r
+\r
+proc array-set-from-PATCHISTO { array_name patch_file ul_list {max_i ALL} {max_p ALL} } {\r
+\r
+ upvar $array_name tab\r
+ if { $max_i == "ALL" } { set maxindice 1000000 } else { set maxindice $max_i }\r
+ if { $max_p == "ALL" } { set maxpatch 1000000 } else { set maxpatch $max_p }\r
+ if [ file readable $patch_file ] {\r
+ set f [open $patch_file r]\r
+ set line {}\r
+ incr maxindice\r
+ while { [ gets $f line ] >= 0 && [ lindex $line 0 ] != $maxindice } {\r
+ if { [ llength $line ] != 0 } { \r
+ if { [ ctype alnum [ lindex $line 0 ] ] == 1 } {\r
+ \r
+ set ul_name [lindex $line 1]\r
+ set ul_level [lindex $line 2]\r
+ if { [lindex $ul_list 0] == "ALL" } {\r
+ set tab($ul_name) $ul_level \r
+ } else {\r
+ foreach ul $ul_list {\r
+ if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } {\r
+ set tab($ul_name) [expr min($ul_level,$maxpatch)] \r
+ break\r
+ }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ }\r
+ close $f\r
+ } else {\r
+ #puts stderr "Info : Can't find $patch_file, no patch exist for this configuration"\r
+ return 0\r
+ }\r
+ return 1\r
+}\r
+\r
+#=================================================================\r
+# ARRAY-PRINT (egu)\r
+#=================================================================\r
+proc array-print { array_name } {\r
+ upvar $array_name tab\r
+ set lst [lsort [array names tab]] \r
+ foreach elt $lst {\r
+ set s [format "%-20s\t%s" $elt $tab($elt)]\r
+ puts stdout $s\r
+ }\r
+}\r
+\r
+#=================================================================\r
+# PARCEL-EXIST (egu)\r
+# test if parcel exist\r
+# Last modif: 27/07/98: for wok (param del become param ul)\r
+#=================================================================\r
+\r
+proc parcel-exist { ul conf } {\r
+ set del [lindex [split $ul "-"] 0]\r
+ #verrue wok\r
+ if { $del == "wok" } { \r
+ if [file exists [wokparam -e %BAG_Home]/${ul}] { \r
+ return 1 \r
+ } else {\r
+ return 0\r
+ }\r
+ }\r
+ #fin verrue wok\r
+ set ul_name ${del}-${conf}\r
+ set lst [ Winfo -p [finfo]:[finfo -W]]\r
+ if {[lsearch -exact $lst $ul_name] == -1} { return 0 } else { return 1 }\r
+}\r
+#=================================================================\r
+# PARCEL-PATH (egu)\r
+# return parcel-path, 0 if it parcel doesn't exist\r
+# Last modif: 27/07/98: for wok (param del become param ul)\r
+#=================================================================\r
+\r
+proc parcel-path { ul conf } {\r
+ set del [lindex [split $ul "-"] 0]\r
+ if [parcel-exist $ul $conf] {\r
+ if { $del == "wok" } {\r
+ set path [wokparam -e %BAG_Home]/${ul}\r
+ } else {\r
+ set path [wokinfo -p HomeDir [finfo]:[finfo -W]:${del}-${conf}]\r
+ }\r
+ return $path\r
+ } else {\r
+ return 0\r
+ }\r
+}\r
+#=================================================================\r
+# PARCEL-LEVEL (egu)\r
+# return the patch top level already install, -1 if no install\r
+# Last modif: 27/07/98: for wok (param del become param ul)\r
+#=================================================================\r
+\r
+proc parcel-level { ul conf } {\r
+ if [parcel-exist $ul $conf] {\r
+ set del [lindex [split $ul "-"] 0]\r
+ if { $del == "wok" } { \r
+ set getpatch_file [parcel-path $ul $conf]/.${ul}.GETPATCH \r
+ } else {\r
+ set getpatch_file [parcel-path $ul $conf]/.${del}-${conf}.GETPATCH\r
+ }\r
+ if [file exists $getpatch_file] {\r
+ set list_level [lsort -integer [p-get-installed $getpatch_file]]\r
+ set index [llength $list_level]\r
+ incr index -1\r
+ return [lindex $list_level $index]\r
+ } else {\r
+ return 0\r
+ }\r
+ } else {\r
+ return -1\r
+ }\r
+}\r
+\r
+#=================================================================\r
+# INSTALL-UL (egu)\r
+#\r
+# create and declare parcel, return 0 if failled\r
+# if success : return patch level already install\r
+# 27/07/98: verrue for wok (egu) ajout option force et runtime\r
+# 10/08/98: supression option vernose et no-execute\r
+#=================================================================\r
+\r
+proc install-ul { ul_name src_dir dest_dir conf tab_error RUNTIME FORCE} {\r
+ \r
+ ### variables setting\r
+ upvar $tab_error tab_err\r
+\r
+ #verrue anti verion pour wok\r
+ set MYDEL [lindex [split $ul_name "-"] 0]\r
+ if { $MYDEL == "wok" } {\r
+ set MYPARCEL ${ul_name}\r
+ } else {\r
+ set MYPARCEL ${MYDEL}-${conf}\r
+ }\r
+ set WAREHOUSE_ADM_PATH [wokparam -e %[finfo -W]_Adm]\r
+ set wdeclare_file ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl \r
+ set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH\r
+ set parcellist_file ${WAREHOUSE_ADM_PATH}/ParcelList \r
+ \r
+ ### on verifie l'existence du fichier a decompresser\r
+ set tar ${src_dir}/${ul_name}.tar.gz\r
+ if ![file exists $tar] {\r
+ puts stderr ".... error"\r
+ puts stderr "Nothing done : Cannot find $tar"\r
+ set tab_err($ul_name) "Nothing done : Cannot find $tar"\r
+ return 0\r
+ }\r
+ \r
+ ### test cause option -d : dest_dir peut deja exister\r
+ if { ![file exists $dest_dir] } {\r
+ puts stdout " - Mkdir $dest_dir ..."\r
+ if [catch { mkdir $dest_dir} mkstat] {\r
+ puts stderr ".... error"\r
+ puts stderr "Nothing done : Cannot create $dest_dir : $mkstat"\r
+ set tab_err($ul_name) "Nothing done : Cannot create $dest_dir : $mkstat"\r
+ return 0\r
+ }\r
+ }\r
+ \r
+ ### security cleaning\r
+ if [file exists $getpatch_file] { \r
+ puts stdout " - remove $getpatch_file"\r
+ exec rm -rf $getpatch_file \r
+ }\r
+ \r
+ ### let's go\r
+ puts stdout " - Downloading $tar in $dest_dir..."\r
+ p-get-ptar $ul_name $dest_dir $tar\r
+ \r
+ ### in FORCE case without first classic install\r
+ \r
+ if { $MYDEL != "wok" && $FORCE } { \r
+ if ![file exists [wokparam -e %[finfo -W]_Adm]/${MYPARCEL}.edl] { \r
+ set FORCE 0 \r
+ puts stdout " -> Info: ${MYPARCEL} has never been declared, it will in spite of FORCE option"\r
+ }\r
+ }\r
+ \r
+ # if: verrue for wok: pas de declaration\r
+ if { $MYDEL != "wok" && !$FORCE } {\r
+ if { [file exists ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl] } {\r
+ puts stderr ".... error"\r
+ puts stderr "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists"\r
+ set tab_err($ul_name) "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists"\r
+ return 0\r
+ } else {\r
+ puts stdout " - Wdeclare ${MYPARCEL} (Don't worry about \"Error : No entity...\")" \r
+ puts stdout " -> Info: Wdeclare create $wdeclare_file and update $parcellist_file"\r
+ \r
+ if { [catch { Wdeclare -p $MYPARCEL -d -DHome=${dest_dir} -DStations=[join [wokparam -e %[finfo -W]_Stations] " "] -DDelivery=${MYDEL} [finfo -W] } ] } {\r
+ puts stderr ".... error" \r
+ puts stderr "Error Wdeclare $MYPARCEL"\r
+ set tab_err($ul_name) "Error Wdeclare $MYPARCEL"\r
+ return 0\r
+ } \r
+ }\r
+ \r
+ #declaration\r
+ set FACTORY_ADM_PATH [wokparam -e %[finfo]_Adm]\r
+ puts stdout " - Updating ${FACTORY_ADM_PATH}/${conf}.edl file... "\r
+ if {[maj-conf-edl $conf $MYPARCEL $RUNTIME] == 0 } {\r
+ puts stderr ".... error"\r
+ puts stderr "Cannot update ${FACTORY_ADM_PATH}/${conf}.edl"\r
+ set tab_err($ul_name) "Error : Cannot update ${FACTORY_ADM_PATH}/${conf}.edl"\r
+ return 0\r
+ }\r
+ } \r
+ return 1 \r
+}\r
+#=================================================================\r
+# MAJ-CONF-EDL (egu)\r
+# Mise a jour du fichier BAG/adm/${conf}.edl\r
+# return 1 si ok, 0 sinon\r
+#=================================================================\r
+\r
+proc maj-conf-edl { conf new_parcel RUNTIME } {\r
+ set admdir [wokparam -e %[finfo]_Adm]\r
+ set lst_conf {}\r
+ set lst_runt {}\r
+ if [file exists ${admdir}/${conf}.edl] {\r
+ wokclose -a [wokparam -e %[finfo]_Home]\r
+ set lst_conf [join [wokparam -e %${conf}_Config] ]\r
+ ### test cause old version of $file.edl\r
+ if ![ catch { wokparam -e %${conf}_Runtime } toto ] {\r
+ set lst_runt [join [wokparam -e %${conf}_Runtime] ]\r
+ } \r
+ exec rm -rf ${admdir}/${conf}.edl \r
+ } else {\r
+ #lappend lst_conf $new_parcel\r
+ } \r
+ if { $RUNTIME } {\r
+ lappend lst_runt $new_parcel\r
+ } else {\r
+ lappend lst_conf $new_parcel\r
+ }\r
+ return [make-conf-edl $conf $lst_conf $lst_runt ]\r
+}\r
+#=================================================================\r
+# MAKE-CONF-EDL (egu)\r
+#=================================================================\r
+\r
+proc make-conf-edl { conf lst_conf lst_runt } {\r
+ set admdir [wokparam -e %[finfo]_Adm]\r
+ set path ${admdir}/${conf}.edl\r
+ if [ catch { set fid [ open $path w ] } ] {\r
+ return 0\r
+ } else {\r
+ puts $fid "@set %${conf}_Config = \"$lst_conf\"; "\r
+ puts $fid "@set %${conf}_Runtime = \"$lst_runt\"; "\r
+ close $fid\r
+ wokclose -a [wokparam -e %[finfo]_Home]\r
+ return 1\r
+ }\r
+}\r
+#=================================================================\r
+# INSTALL-PATCH (egu)\r
+#=================================================================\r
+\r
+proc install-patch { ul_name patch_level src_dir dest_dir conf tab_error} {\r
+ upvar $tab_error tab_err\r
+ set tar ${src_dir}/${ul_name}_${patch_level}.tar.gz\r
+ if ![catch { file exists $tar } ] {\r
+ set MYDEL [lindex [split $ul_name "-"] 0]\r
+ if { $MYDEL == "wok" } {\r
+ set MYPARCEL ${ul_name}\r
+ } else {\r
+ set MYPARCEL ${MYDEL}-${conf}\r
+ }\r
+\r
+ #untar\r
+ puts stdout " - Downloading $tar in $dest_dir... "\r
+ p-get-ptar ${ul_name}_${patch_level} $dest_dir $tar\r
+ \r
+ # updating .GETPATCH file\r
+ set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH\r
+ puts stdout " - Updating $getpatch_file file..."\r
+ set now [string range [fmtclock [getclock]] 0 18]\r
+ if [file exists $getpatch_file] {\r
+ set lf [putils:FILES:FileToList $getpatch_file]\r
+ } else {\r
+ set lf {}\r
+ }\r
+ set s [format "%s %s %s %s" $ul_name ${ul_name}_${patch_level} $dest_dir $now]\r
+ lappend lf $s\r
+ putils:FILES:ListToFile $lf $getpatch_file\r
+ \r
+ \r
+ } else {\r
+ puts stderr ".... error"\r
+ puts stderr "Nothing done : Cannot find $tar"\r
+ set tab_err(${ul_name}_${patch_level}) "Nothing done : Cannot find $tar"\r
+ return 0\r
+ }\r
+ return 1\r
+}\r
+\r
+#=================================================================\r
+# P-GET-INSTALLED (egu)\r
+#\r
+# return list of patch'numbers already write in GETPATCH file \r
+# return null list if file doesn't exist\r
+#=================================================================\r
+\r
+proc p-get-installed { file } {\r
+ if { ![file exists $file] } {\r
+ return {}\r
+ } else {\r
+ set ll {}\r
+ foreach l [putils:FILES:FileToList $file] {\r
+ lappend ll [lindex [split [lindex $l 1] _] end]\r
+ }\r
+ return $ll\r
+ }\r
+}\r
+\r
+###==============================================================================================\r
+\r
+proc p-get-ptar { MYUL ULBAG tar } {\r
+\r
+ global tcl_platform\r
+ set savpwd [pwd]\r
+ cd $ULBAG\r
+\r
+ if { "$tcl_platform(platform)" == "unix" } {\r
+\r
+ putils:EASY:tar untarZ ${tar}\r
+\r
+ } elseif { "$tcl_platform(platform)" == "windows" } {\r
+ set dirtmp [putils:EASY:tmpname ulget[id process]]\r
+ catch { mkdir $dirtmp }\r
+ putils:FILES:copy ${tar} $dirtmp/${MYUL}.tar.gz\r
+\r
+ if { [file exists $dirtmp/${MYUL}.tar] } {\r
+ unlink $dirtmp/${MYUL}.tar\r
+ }\r
+ putils:FILES:uncompress $dirtmp/${MYUL}.tar.gz\r
+ if { [file exists $dirtmp/${MYUL}.tar] } {\r
+ puts stderr "Info : Downloading $tar in [pwd]... "\r
+ putils:EASY:tar untar $dirtmp/${MYUL}.tar\r
+ }\r
+ unlink $dirtmp/${MYUL}.tar\r
+ unlink -nocomplain $dirtmp\r
+ }\r
+ cd $savpwd\r
+ return\r
+}\r
+\r
+#\r
+# ######################################################################\r
+#\r
+proc putils:EASY:GETOPT { prm table tablereq usage listarg } {\r
+\r
+ upvar $table TLOC $tablereq TRQ $prm PARAM\r
+ catch {unset TLOC}\r
+\r
+ set fill 0\r
+\r
+ foreach e $listarg {\r
+ if [regexp {^-.*} $e opt] {\r
+ if [info exists TRQ($opt)] {\r
+ set TLOC($opt) {}\r
+ set fill 1\r
+ } else {\r
+ puts stderr "Error: Unknown option $e"\r
+ eval $usage\r
+ return -1\r
+ }\r
+ } else {\r
+ if [info exist opt] {\r
+ set fill [regexp {value_required:(.*)} $TRQ($opt) all typ]\r
+ if { $fill } {\r
+ if { $TLOC($opt) == {} } {\r
+ set TLOC($opt) $e\r
+ set fill 0\r
+ } else {\r
+ lappend PARAM $e\r
+ }\r
+ } else {\r
+ lappend PARAM $e\r
+ }\r
+ } else {\r
+ lappend PARAM $e\r
+ }\r
+ }\r
+ }\r
+\r
+ foreach e [array names TLOC] {\r
+ if { [regexp {value_required:(.*)} $TRQ($e) all typ ] == 1 } {\r
+ if { $TLOC($e) == {} } {\r
+ puts "Error: Option $e requires a value"\r
+ eval $usage\r
+ return -1\r
+ }\r
+ switch -- $typ {\r
+\r
+ file {\r
+ }\r
+\r
+ string {\r
+ }\r
+ \r
+ date {\r
+ }\r
+\r
+ list {\r
+ set TLOC($e) [split $TLOC($e) ,]\r
+ }\r
+\r
+ number {\r
+ if ![ regexp {^[0-9]+$} $TLOC($e) n ] {\r
+ puts "Error: Option $e requires a number."\r
+ eval $usage\r
+ return -1\r
+ }\r
+ }\r
+\r
+ }\r
+ \r
+ }\r
+ }\r
+\r
+ return\r
+}\r
+#\r
+#\r
+#\r
+proc putils:EASY:tar { option args } {\r
+ \r
+ catch { unset command return_output }\r
+ \r
+ switch -- $option {\r
+ \r
+ tarfromroot {\r
+ set name [lindex $args 0]\r
+ set root [lindex $args 1]\r
+ append command {tar cf } $name " " $root\r
+ }\r
+ \r
+ tarfromliste {\r
+ set name [lindex $args 0]\r
+ set list [lindex $args 1]\r
+ if [file exists $list] {\r
+ set liste [putils:FILES:FileToList [lindex $args 1]]\r
+ append command {tar cf } $name\r
+ foreach f $liste {\r
+#fsa\r
+ set listeeval [eval glob $f]\r
+ foreach ff $listeeval {\r
+ append command " " $ff\r
+ }\r
+#fsa append command " " $f\r
+ }\r
+ } else {\r
+ error "File $list not found"\r
+ return -1\r
+ }\r
+ }\r
+ \r
+ untar {\r
+ set name [lindex $args 0]\r
+ append command {tar xomf } $name\r
+ }\r
+ \r
+ untarZ {\r
+ set name [lindex $args 0]\r
+#fun append command uncompress { -c } $name { | tar xof - >& /dev/null }\r
+ append command gzip { -d -c } $name { | tar xomf - >& /dev/null }\r
+ }\r
+\r
+\r
+ ls {\r
+ set return_output 1\r
+ set name [lindex $args 0]\r
+ append command {tar tvf } $name\r
+ }\r
+\r
+ lsZ {\r
+ set return_output 1\r
+ set name [lindex $args 0]\r
+#fun append command uncompress { -c } $name { | tar tvf - }\r
+ append command gzip -d { -c } $name { | tar tvf - }\r
+ }\r
+\r
+ }\r
+ \r
+ ;#puts "command = $command"\r
+ \r
+ if [catch {eval exec $command} status] {\r
+ puts stderr "Tar messages in command: $command"\r
+ puts stderr "Status : $status"\r
+ set statutar 1\r
+ } else {\r
+ if [info exist return_output] {\r
+ set statutar $status\r
+ } else {\r
+ set statutar 1\r
+ }\r
+ }\r
+\r
+ return $statutar\r
+}\r
+#\r
+#\r
+#\r
+proc putils:FILES:ListToFile { liste path } {\r
+ if [ catch { set id [ open $path w ] } ] {\r
+ return 0\r
+ } else {\r
+ foreach e $liste {\r
+ puts $id $e\r
+ }\r
+ close $id\r
+ return 1\r
+ }\r
+}\r
+#\r
+#\r
+#\r
+proc putils:FILES:FileToList { path {sort 0} {trim 0} {purge 0} {emptl 1} } {\r
+ if ![ catch { set id [ open $path r ] } ] {\r
+ set l {}\r
+ while {[gets $id line] >= 0 } {\r
+ if { $trim } {\r
+ regsub -all {[ ]+} $line " " line\r
+ }\r
+ if { $emptl } {\r
+ if { [string length ${line}] != 0 } {\r
+ lappend l $line\r
+ }\r
+ } else {\r
+ lappend l $line\r
+ }\r
+ }\r
+ close $id\r
+ if { $sort } {\r
+ return [lsort $l]\r
+ } else {\r
+ return $l\r
+ }\r
+ } else {\r
+ return {}\r
+ }\r
+}\r
+#\r
+#\r
+#\r
+proc putils:FILES:copy { fin fout } {\r
+ if { [catch { set in [ open $fin r ] } errin] == 0 } {\r
+ if { [catch { set out [ open $fout w ] } errout] == 0 } {\r
+ set nb [copyfile $in $out]\r
+ close $in \r
+ close $out\r
+ return $nb\r
+ } else {\r
+ puts stderr "Error: $errout"\r
+ return -1\r
+ }\r
+ } else {\r
+ puts stderr "Error: $errin"\r
+ return -1\r
+ }\r
+}\r
+#\r
+#\r
+##\r
+proc putils:FILES:compress { fullpath } {\r
+ if [file exists ${fullpath}.gz] {\r
+ catch {unlink ${fullpath}.gz}\r
+ }\r
+#fsa if [catch { exec compress -f $fullpath} status] \r
+ if [catch { exec gzip -f $fullpath} status] {\r
+ puts stderr "Error while compressing ${fullpath}: $status"\r
+ return -1\r
+ } else {\r
+ return 1\r
+ }\r
+}\r
+\r
+proc putils:FILES:uncompress { fullpath } {\r
+#fsa if [catch {exec uncompress -f $fullpath} status]\r
+#fun:patch K4B_7\r
+ if [catch {exec gzip -d -f $fullpath} status] {\r
+ puts stderr "Error while uncompressing ${fullpath}: $status"\r
+ return -1\r
+ } else {\r
+ return 1\r
+ }\r
+}\r
+\r
+proc putils:EASY:tmpname { name } {\r
+ global env\r
+ global tcl_platform\r
+ if { "$tcl_platform(platform)" == "unix" } {\r
+ if [info exists env(TMPDIR)] {\r
+ return [file join $env(TMPDIR) $name]\r
+ } else { \r
+ return [file join "/tmp" $name]\r
+ }\r
+ } elseif { "$tcl_platform(platform)" == "windows" } {\r
+ return [file join $env(TMP) $name]\r
+ }\r
+ return {}\r
+}\r
+\r
+\r
--- /dev/null
+;# mettre une selection sur les extenstions dans wprepare.
+;#
+proc wcompareUsage { {GiveMore 0} } {
+ puts stderr { }
+ puts stderr { Usage: wcompare dir1 dir2 [-options..] }
+ puts stderr { }
+ puts stderr { Compare the contents of directories under dir1(master) }
+ puts stderr { and dir2(revision). Each file displayed is marked with a flag: }
+ puts stderr { # indicates 2 differents files }
+ puts stderr { = indicates that files in dir1 et dir2 are identicals. }
+ puts stderr { + indicates that the file is in dir2 but not in dir1.("appeared") }
+ puts stderr { - indicates that file is in dir1 but not in dir2 .("removed") }
+ puts stderr { }
+ puts stderr { Options for output: }
+ puts stderr { -hide= : Don't display identical files (marked =) }
+ puts stderr { -o file : Output results in file }
+ puts stderr { }
+ puts stderr { More information with wcompare -H , examples with wcompare -exam }
+ puts stderr { }
+ if { $GiveMore == 0 } { return }
+ puts stderr { Options for filtering: }
+ puts stderr { }
+ puts stderr { -depth depth : Subdirectories whose level is greater than depth are }
+ puts stderr { not compared. (Directory itself is depth =0 ) }
+ puts stderr { -ext e1,e2,. : Select extension file to be compared. Extenstion must }
+ puts stderr { separated by comma, and begin with a dot (.) }
+ puts stderr { Ex: wcompare d1 d2 -ext .cxx,.hxx,.jxx }
+ puts stderr { See also -compare option for more sophisticated filter.}
+ puts stderr { -dir d1,d2,. : Select directory names to be compared. Names can be }
+ puts stderr { glob-style match. }
+ puts stderr { -Xdir d1,d2, : Same as above but excludes directory from comparison }
+ puts stderr { }
+ puts stderr { Option for modifying comparison: }
+ puts stderr { }
+ puts stderr { -compare TclComm : Specify your own comparison function }
+ puts stderr { }
+ puts stderr { TclComm is called with 2 arguments, the full pathes of the files }
+ puts stderr { to compare. }
+ puts stderr { If the script returns 1 the file will be marked # in the report }
+ puts stderr { If the script returns 0 the file will be marked = in the report }
+ puts stderr { By default, Comparison is done using contents of the files. }
+ puts stderr { }
+ puts stderr { Option for acting on files according to the result of comparison: }
+ puts stderr { }
+ puts stderr { -do TclComm : Specify a Tcl command to act on files. }
+ puts stderr { }
+ puts stderr { TclComm is called with 5 arguments a1 a2 a3 a4 a5: }
+ puts stderr { a1 is the string "f" or "d" to indicate the type of a3 and a4 }
+ puts stderr { "d" stands for "directory" and "f" for simple file. }
+ puts stderr { a2 contains the result of the comparison (= - + #) }
+ puts stderr { a3 the directory (or {} ) of the first file being compared. }
+ puts stderr { a4 the directory (or {} ) of the second file being compared. }
+ puts stderr { a5 the basename of the file for a plain file. }
+ puts stderr { In that case above options for formatting output are ignored. }
+ puts stderr { For example such a routine could be used to update the contents }
+ puts stderr { of dir2 (considered as the revision file ) according to dir1 }
+ puts stderr { (considered as the master file). }
+ puts stderr { }
+ puts stderr { Examples with wcompare -exam }
+ return
+}
+
+proc wcompareExamples { } {
+ puts stderr { }
+ puts { Compare 2 directories and send output in file /tmp/diff: }
+ puts { > wcompare /adv_23/WOK/k4/ref /adv_23/WOK/k5/ref -o /tmp/diff }
+ puts { }
+ puts { Same as above, exclude directories *drv*, select .cxx and .hxx files: }
+ puts { > wcompare /adv_23/WOK/k4/ref /adv_23/WOK/k5/ref -xdir *drv* -ext .cxx,.hxx }
+ puts { }
+ puts { Uses routine "wcompare:Quick"(*) instead of default comparison,don't display same files. }
+ puts { > wcompare -compare wcompare:Quick /dp_87/IMA/DMGR-K4B /adv_32/IGD/DMGR-A4-1 -hide= }
+ puts { }
+ puts { Same as above, keep *ao1* directories but exclude adm directories and hxx files: }
+ puts { > wcompare -compare wcompare:Quick /dp_87/IMA/DMGR-K4B /adv_32/IGD/DMGR-A4-1 -dir *ao1* -xdir *.adm* }
+ puts { Compare but do not examine any directories or files below level 3 if any: }
+ puts { > wcompare /adv_23/WOK/k4dev /adv_23/WOK/k5dev -depth 3 }
+ puts { }
+ puts { Compare 2 directories, ignore sub-directories, uses proc wcompare:ExampleDo(**) to act on files. }
+ puts { > wcompare /usr/home/guest /usr/home/me -depth 0 -do wcompare:ExampleDo }
+ puts { }
+ puts { (*) See args and code of wcompare:Quick: }
+ puts { > info args wcompare:Quick }
+ puts { > info body wcompare:Quick }
+ puts { }
+ puts { (**) See args and code of wcompare:ExampleDo. (Reproduce default output of wcompare) }
+ puts { > info args wcompare:ExampleDo }
+ puts { > info body wcompare:ExampleDo }
+ puts { }
+ return
+}
+
+
+proc wcompare { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-H) {}
+ set tblreq(-o) value_required:file
+ set tblreq(-hide=) {}
+ set tblreq(-compare) value_required:string
+ set tblreq(-depth) value_required:string
+ set tblreq(-do) value_required:string
+ set tblreq(-ext) value_required:list
+ set tblreq(-dir) value_required:list
+ set tblreq(-xdir) value_required:list
+ set tblreq(-exam) {}
+
+ set param {}
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wcompareUsage $args] == -1 } return
+
+ if [info exists tabarg(-h)] {
+ wcompareUsage
+ return
+ }
+
+ if [info exists tabarg(-H)] {
+ wcompareUsage 1
+ return
+ }
+
+ if [info exists tabarg(-exam)] {
+ wcompareExamples
+ return
+ }
+
+ set hidee [info exists tabarg(-hide=)]
+
+ if { [llength $param] != 2 } {
+ wcompareUsage
+ return
+ }
+
+ if { [file exists [set d1 [lindex $param 0]]] } {
+ if { ![file isdirectory $d1] } {
+ puts stderr "$d1 is not a directory"
+ return
+ }
+ } else {
+ puts stderr "Directory $d1 does not exists."
+ return
+ }
+
+ if { [file exists [set d2 [lindex $param 1]]] } {
+ if { ![file isdirectory $d2] } {
+ puts stderr "$d2 is not a directory"
+ return
+ }
+ } else {
+ puts stderr "Directory $d2 does not exists."
+ return
+ }
+
+ if [info exists tabarg(-o)] {
+ if [ catch { set fileid [ open $tabarg(-o) w ] } status ] {
+ puts stderr "$status"
+ return
+ }
+ } else {
+ set fileid stdout
+ }
+
+
+ if [info exists tabarg(-do)] {
+ set DoFunc $tabarg(-do)
+ } else {
+ set DoFunc {}
+ }
+
+ set CompareFunc wokUtils:FILES:AreSame
+ if [info exists tabarg(-compare)] {
+ set CompareFunc $tabarg(-compare)
+ }
+
+ set gblist {}
+ if [info exists tabarg(-ext)] {
+ foreach e $tabarg(-ext) {
+ lappend gblist $e
+ }
+ }
+
+ wokUtils:FILES:DirToMap $d1 mas
+ wokUtils:FILES:DirToMap $d2 rev
+
+ if [info exists tabarg(-depth)] {
+ set depth [expr $tabarg(-depth) + 1]
+ 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) {
+ 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) {
+ 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)
+ }
+ }
+ }
+ }
+
+ ;#
+ ;# Bay gio chung minh phai lam viec.
+ ;#
+ set lcom [wokUtils:LIST:i3 [array names mas] [array names rev]]
+
+ if { $DoFunc !={} } {
+ foreach dir [lsort [lindex $lcom 1]] {
+ $DoFunc d # $d1$dir $d2$dir {}
+ wokUtils:LIST:SimpleDiff COMP $mas($dir) $rev($dir) $gblist
+ if [array exists COMP] {
+ wokUtils:LIST:CompareAllKey COMP $CompareFunc
+ foreach f [lsort [array names COMP]] {
+ switch -- [lindex $COMP($f) 0] {
+ = {
+ $DoFunc f = [file dirname [lindex $COMP($f) 1]] \
+ [file dirname [lindex $COMP($f) 2]] $f
+ }
+ # {
+ $DoFunc f # [file dirname [lindex $COMP($f) 1]] \
+ [file dirname [lindex $COMP($f) 2]] $f
+ }
+ - {
+ $DoFunc f - [lindex $COMP($f) 1] {} $f
+ }
+
+ + {
+ $DoFunc f + {} [lindex $COMP($f) 1] $f
+ }
+ }
+ }
+ }
+ foreach dir [lsort [lindex $lcom 0]] { $DoFunc d - $d1$dir {} {} }
+ foreach dir [lsort [lindex $lcom 2]] { $DoFunc d + {} $d2$dir {} }
+ }
+ } else {
+ set pnts " "
+ foreach dir [lsort [lindex $lcom 1]] {
+ puts $fileid "\n## Directory $d1$dir and $d2$dir\n "
+ wokUtils:LIST:SimpleDiff COMP $mas($dir) $rev($dir) $gblist
+ if [array exists COMP] {
+ foreach e [lsort [array names COMP]] {
+ set flag [lindex $COMP($e) 0]
+ set f1 [lindex $COMP($e) 1]/$e
+ set f2 [lindex $COMP($e) 2]/$e
+ if { [string compare $flag ?] == 0 } {
+ if { [$CompareFunc $f1 $f2] == 1 } {
+ if { $hidee == 0 } {
+ puts $fileid [format " = %-30s %-40s %s" $e [lindex $COMP($e) 1] [lindex $COMP($e) 2]]
+ }
+ } else {
+ puts $fileid [format " # %-30s %-40s %s" $e [lindex $COMP($e) 1] [lindex $COMP($e) 2]]
+ }
+ } elseif { "$flag" == "+" } {
+ puts $fileid [format " + %-30s %s %s" $e $pnts [lindex $COMP($e) 1]]
+ } elseif { "$flag" == "-" } {
+ puts $fileid [format " - %-30s %s %s" $e [lindex $COMP($e) 1] $pnts]
+ }
+ }
+ }
+ }
+
+ foreach dir [lsort [lindex $lcom 0]] {
+ puts $fileid "\n-- Directory $d1$dir\n"
+ foreach f [readdir $d1$dir] {
+ puts $fileid [format " - %-30s %s %s" $f $d1$dir $pnts]
+ }
+ }
+
+ foreach dir [lsort [lindex $lcom 2]] {
+ puts $fileid "\n++ Directory $d2$dir\n"
+ foreach f [readdir $d2$dir] {
+ puts $fileid [format " + %-30s %s %s" $f $pnts $d2$dir]
+ }
+ }
+
+ if { [string match file* $fileid] } {
+ close $fileid
+ }
+ }
+ return
+}
+
+proc wcompare:ExampleDo { type flag f1 f2 f} {
+ if { "$type" == "f" } {
+ switch -- $flag {
+ = {
+ puts [format " = %-30s %-40s %s" $f $f1 $f2]
+ }
+ # {
+ puts [format " # %-30s %-40s %s" $f $f1 $f2]
+ }
+ - {
+ set pnts " "
+ puts [format " - %-30s %s %s" $f $f1 $pnts]
+ }
+ + {
+ set pnts " "
+ puts [format " - %-30s %s %s" $f $pnts $f2]
+ }
+ }
+ } else {
+ switch -- $flag {
+ # {
+ puts "\n## Directory $f1 and $f2\n "
+ }
+ - {
+ puts "\n-- Directory $f1\n"
+ set pnts " "
+ foreach f [readdir $f1] {
+ puts [format " + %-30s %s %s" $f $f1 $pnts]
+ }
+ }
+ + {
+ puts "\n++ Directory $f2\n"
+ set pnts " "
+ foreach f [readdir $f2] {
+ puts [format " + %-30s %s %s" $f $pnts $f2]
+ }
+ }
+ }
+ }
+ return
+}
+
+proc wcompare:Quick { f1 f2 } {
+ if { [file mtime $f1] != [file mtime $f2] } {
+ set ls1 [file size $f1]
+ set ls2 [file size $f2]
+ if { $ls1 == $ls2 } {
+ set id1 [open $f1 r]
+ set id2 [open $f2 r]
+ set s1 [read $id1 $ls1]
+ set s2 [read $id2 $ls2]
+ close $id1
+ close $id2
+ if { $s1 == $s2 } {
+ return 1
+ } else {
+ return 0
+ }
+ } else {
+ return 0
+ }
+ } else {
+ return 1
+ }
+}
--- /dev/null
+#############################################################################
+#
+# W N E W S
+# _____________
+#
+#############################################################################
+#
+# Usage
+#
+proc wokNewsUsage { } {
+ puts stderr { Usage :}
+ puts stderr { }
+ puts stderr { wnews [-x] [-from p1 -to p2] [-headers|-units|-comments|-all] [-command TclCmd] }
+ puts stderr { }
+ puts stderr { Extract a slice of the journal file between index p1 and p2}
+ puts stderr { p1 et p2 are integration number or marks (See format below)}
+ puts stderr { If p1 is not specified, reports are extracted from the beginning of the journal file.}
+ puts stderr { If p2 is not specified, reports are extracted up to the end of the journal file.}
+ puts stderr { }
+ puts stderr { wnews -set markname [ -at p ] [-c "stringcomment"] [-cf filecomment] }
+ puts stderr { }
+ puts stderr { Place a mark at the index p. p is a integration number. }
+ puts stderr { If is not given,the mark is placed at the end of the journal.}
+ puts stderr { stringcomment is a comment for the mark. You can give a file name, by using -cf option. }
+ puts stderr { }
+ puts stderr { wnews -ls [-bydate]}
+ puts stderr { }
+ puts stderr { List the marks. If -bydate is specified thay are listed in the order they were created.}
+ puts stderr { Otherwise they are listed in order according to their place in the journal file.}
+ puts stderr { }
+ puts stderr { wnews -rm markname}
+ puts stderr { }
+ puts stderr { Remove the mark markname}
+ puts stderr { }
+ puts stderr { wnews -admin }
+ puts stderr { }
+ puts stderr { Display journal location, date and other informations.}
+ puts stderr { }
+ puts stderr { wnews -purge }
+ puts stderr { }
+ puts stderr { Save the journal file and creates a new empty one.}
+ puts stderr { }
+ puts stderr { Additionals options : }
+ puts stderr { }
+ puts stderr { -o file <name> redirect output in file. This option is ignored if -command is specified.}
+ puts stderr { -ws <shop> uses journal of <shop> instead of the current one. <shop> must belongs to }
+ puts stderr { the current factory.}
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc wnews { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-x) {}
+ set tblreq(-from) value_required:string
+ set tblreq(-to) value_required:string
+ set tblreq(-headers) {}
+ set tblreq(-units) {}
+ set tblreq(-comments) {}
+ set tblreq(-all) {}
+ set tblreq(-command) value_required:string
+ set tblreq(-userdata) value_required:string
+
+ set tblreq(-rm) value_required:string
+ set tblreq(-set) value_required:string
+ set tblreq(-at) value_required:number
+
+ set tblreq(-c) value_required:string
+ set tblreq(-cf) value_required:string
+
+
+ set tblreq(-ls) default
+ set tblreq(-bydate) {}
+
+ set tblreq(-admin) {}
+ set tblreq(-purge) {}
+
+ set tblreq(-o) value_required:string
+
+ set tblreq(-ws) value_required:string
+
+ set disallow(-x) {-set -ls -rm -admin -purge }
+ set disallow(-admin) {-set -ls -rm -purge }
+ set disallow(-bydate) {-set -rm -admin -purge }
+
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokNewsUsage $args] == -1 } return
+ if { [wokUtils:EASY:DISOPT tabarg disallow wokNewsUsage ] == -1 } return
+
+ if { $param != {} } {
+ wokNewsUsage
+ return
+ }
+
+ if { [info exists tabarg(-h)] } {
+ wokNewsUsage
+ return
+ }
+
+ if [info exists tabarg(-ws)] {
+ set fshop $tabarg(-ws)
+ } else {
+ set fshop [wokinfo -s [wokcd]]
+ }
+
+ if { [set journal [wokIntegre:Journal:GetName $fshop]] == {} } {
+ msgprint -c WOKVC -e "Journal file not found in workshop $fshop."
+ return
+ }
+
+ if [info exists tabarg(-x)] {
+ if [info exists tabarg(-o)] {
+ if ![ catch { set newsfileid [ open $tabarg(-o) w ] } ] {
+ set newsoutput [list puts $newsfileid]
+ } else {
+ msgprint -c WOKVC -e "Fail to open $tabarg(-o) for writing."
+ return
+ }
+ } else {
+ set newsoutput [list puts stdout]
+ }
+
+ set command wokNewsSlicer
+ set userdata [list [info exists tabarg(-all)] [info exists tabarg(-headers)] \
+ [info exists tabarg(-units)] [info exists tabarg(-comments)] ]
+ lappend userdata $newsoutput
+
+ if [info exists tabarg(-command)] {
+ set command $tabarg(-command)
+ set userdata {}
+ if [info exists tabarg(-userdata)] {
+ set userdata $tabarg(-userdata)
+ }
+ }
+
+ set end [expr { [wokIntegre:Number:Get $fshop] - 1 } ]
+ set mark_from 1
+ if [info exists tabarg(-from)] {
+ if { [string toupper $tabarg(-from)] == "END" } {
+ set mark_from $end
+ } else {
+ set mark_from $tabarg(-from)
+ }
+ }
+
+ set mark_to $end
+ if [info exists tabarg(-to)] {
+ if { [string toupper $tabarg(-to)] != "END" } {
+ set mark_to $tabarg(-to)
+ }
+ }
+
+ wokNewsExtract
+ if [info exists newsfileid] {
+ catch { close $newsfileid }
+ }
+ return
+ }
+
+ if [info exists tabarg(-set)] {
+ set mark_name $tabarg(-set)
+ if [info exists tabarg(-at)] {
+ set mark_value $tabarg(-at)
+ } else {
+ set mark_value [wokIntegre:Number:Get $fshop]
+ }
+ if { $journal != {} } {
+ if { [wokIntegre:Mark:GetTableName $journal 1] != {} } {
+ wokIntegre:Mark:Set $journal $mark_name $mark_value
+ if [info exists tabarg(-c)] {
+ wokIntegre:Mark:SetComment $journal string $mark_name $tabarg(-c)
+ }
+ if [info exists tabarg(-cf)] {
+ if [file exists $tabarg(-cf)] {
+ wokIntegre:Mark:SetComment $journal file $mark_name $tabarg(-cf)
+ } else {
+ msgprint -e "File $tabarg(-cf) not found. Mark not commented"
+ }
+ }
+ }
+ }
+ return
+ }
+
+ if [info exists tabarg(-ls)] {
+ foreach x [wokIntegre:Mark:Dump $journal [info exists tabarg(-bydate)]] {
+ if [regexp {([-A-Za-z][-A-Za-z0-9]*) ([0-9]+),([0-9]+)} $x all mark index date] {
+ puts stdout [format "%10s = %-3d (placed at %s)" $mark $index [fmtclock $date] ]
+ }
+ }
+ return
+ }
+
+ if [info exists tabarg(-rm)] {
+ set mark $tabarg(-rm)
+ if { $journal != {} } {
+ wokIntegre:Mark:Del $journal $mark
+ }
+ return
+ }
+
+ if [info exists tabarg(-admin)] {
+ puts stdout "\n Journal file in directory [file dirname $journal] \n"
+ foreach j [wokIntegre:Journal:List $fshop] {
+ puts stdout [format "%15s %-9d" [file tail $j] [file size $j]]
+ }
+ set t [fmtclock [file mtime $journal]]
+ puts stdout \
+ [format "%15s %-8d(Last modified %s)" [file tail $journal] [file size $journal] $t]
+
+ set scoop [wokIntegre:Scoop:Read $fshop]
+ if { $scoop != {} } {
+ puts stdout "\n Last integration: \n\n $scoop "
+ }
+ puts stdout "\n Marks: \n"
+ wnews -ls -ws $fshop
+ return
+ }
+
+ if [info exists tabarg(-purge)] {
+ wokIntegre:Journal:Purge $fshop
+ return
+ }
+
+}
+
+proc wokNewsExtract { } {
+ uplevel {
+ set n1 [wokIntegre:Mark:Trn $journal $mark_from]
+ set n2 [wokIntegre:Mark:Trn $journal $mark_to]
+ if { $n1 != {} && $n2 != {} } {
+ set jnltmp [wokUtils:FILES:tmpname wgetslice[id process]]
+ wokIntegre:Journal:Assemble $jnltmp $fshop [wokIntegre:Journal:GetBigSlice $n1 $n2 $fshop]
+ if { [file size $jnltmp] != 0 } {
+ wokIntegre:Journal:Slice $jnltmp $n1 $n2 $command $userdata
+ }
+ }
+ catch { unlink $jnltmp }
+ }
+ return
+}
+;#
+;#
+;#
+proc wokNewsSlicer { comment table args } {
+ upvar $table TLOC
+ set userdata [lindex [lindex $args 0] 0]
+ set lall [lindex $userdata 0]
+ set lheaders [lindex $userdata 1]
+ set lunits [lindex $userdata 2]
+ set lcomments [lindex $userdata 3]
+ set loutput [lindex $userdata 4]
+ if { $lall } {
+ if [array exists TLOC] {
+ parray TLOC
+ }
+ } elseif { $lunits } {
+ foreach ud [array names TLOC] {
+ eval $loutput $ud
+ }
+ } elseif { $lcomments } {
+ set locmt $comment
+ while { [set line [ctoken locmt \n]] != "" } {
+ if { "[string range $line 0 1]" == "--" } {
+ eval $loutput [list $line]
+ }
+ }
+ } elseif { $lheaders } {
+ set locmt $comment
+ while { [set line [ctoken locmt \n]] != "" } {
+ if { "[string range $line 0 5]" == "Report" } {
+ eval $loutput [list $line]
+ }
+ }
+ }
+
+ return 1
+
+}
+
+
+#
+# ((((((((((((((((JOURNAL))))))))))))))))
+#
+#;>
+# Ecrit un template de ReleaseNotes, si fileid = -1 retourne une liste
+#;<
+proc wokIntegre:Journal:ReleaseNotes { {fileid stdout} } {
+ if { $fileid != -1 } {
+ 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;"
+ } else {
+ return [append dummyvar \
+ "Author : " \n \
+ "Study/CSR : " \n \
+ "Debug : " \n \
+ "Improvements : " \n \
+ "News : " \n \
+ "Deletions : " \n \
+ "Impact : " \n \
+ "Comments : " \n ]
+ }
+}
+#;>
+# Retourne vraiment n'importe quoi.
+#;<
+proc wokIntegre:Journal:EditReleaseNotes { {A {}} {S {}} {D {}} {I {}} {N {}} {D {}} {I {}} {C {}} } {
+ return [list \
+ "Author : $A" \
+ "Study/CSR : $S" \
+ "Debug : $D" \
+ "Improvements : $I" \
+ "News : $N" \
+ "Deletions : $D" \
+ "Impact : $I" \
+ "Comments : $C"
+ ]
+}
+#;>
+# Retourne le full path du fichier journal associe a shop
+#;<
+proc wokIntegre:Journal:GetName { fshop {create 0} } {
+ set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/wintegre.jnl
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating file $diradm"
+ catch { mkdir -path [file dirname $diradm] }
+ wokUtils:FILES:ListToFile {} $diradm
+ chmod 0777 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+}
+
+# Retourne une marque unique pour ecrire dans le journal comme header de report.
+# et pour mettre un commentaire des BASES
+#;<
+proc wokIntegre:Journal:Mark { string number rep } {
+ return [format "%s:%s_%s" $string $number $rep]
+}
+#;>
+#; inverse
+#;<
+proc wokIntegre:Journal:UnMark { string } {
+ if [regexp {(.*):(.*)_(.*)} $string all strout number rep] {
+ return [list $strout $number $rep]
+ }
+}
+#;>
+# Ecrit sur jnlid le header d'un report
+#;<
+proc wokIntegre:Journal:WriteHeader { rep num wb station {jnlid stdout}} {
+ set report_out [format "%s_%s" $num $rep]
+ set today [fmtclock [getclock] "%d/%m/%y %R"]
+ puts $jnlid [format "\n\nReport %s - %s from workbench %s (%s)" $report_out $today $wb $station]
+ puts $jnlid [format "------------"]
+ return
+}
+#;>
+# Ecrit sur jnlid les strings se trouvant dans Notes precedees du separareur "--"
+#;<
+proc wokIntegre:Journal:WriteNotes { Notes {jnlid stdout }} {
+ foreach s $Notes {
+ puts $jnlid [format "-- %s" $s]
+ }
+ return
+}
+#;>
+# retourne le bout du journal contenant les reports dont la date est superieure a celle donnee.
+#;<
+proc wokIntegre:Journal:Since { file date1 date2 } {
+ if [ catch { set fileid [open $file r] } ] {
+ return {}
+ }
+ set ret {}
+ set fillnow 0
+ while {[gets $fileid line] >= 0} {
+ if {[regexp {^Report [0-9]*_rep - ([0-9]*/[0-9]*/[0-9]* [0-9]*:[0-9]*)} $line all datrep] } {
+ set cdat [wokUtils:TIME:dpe $datrep]
+ if { $cdat >= $date1 && $cdat <= $date2 } {
+ append ret $line \n
+ set fillnow 1
+ } elseif { $cdat > $date2 } {
+ break
+ }
+ } else {
+ if { $fillnow } {
+ append ret $line \n
+ }
+ }
+ }
+ close $fileid
+ return $ret
+}
+#;>
+# Ecrit dans table, le contenu d'un report file (full path).
+# Retourne le header complet du report trouve.
+# Entree: Numero de report ou le mot cle end pour lire le dernier report
+# Format: table (UD) = {{f1 v1} {f2 v2} ... {fn vn}}
+# fi = nom (basename) du fichier. vi sa version.
+#;<
+proc wokIntegre:Journal:PickReport { file table notes ReportNum {action fill } } {
+ upvar $table TLOC $notes NLOC
+
+ if [ catch { set fileid [open $file r] } ] {
+ return {}
+ }
+
+ set num $ReportNum
+
+ set R_begrgx [format {^Report %s_.* -} $num]
+ set U_begrgx {^ ([^ ]*) ([^ ]*) :}
+ set F_begrgx {^ ([^ ]*)[ ]*: ([^ ]*) ([^ ]*)}
+
+ set R_begheader [scancontext create]
+
+ ;# Pointe sur le header du report demande
+ ;#
+ set NLOC {}
+ set REPORT {}
+ set TEXTE {}
+ scanmatch $R_begheader $R_begrgx {
+ set REPORT $matchInfo(line)
+ while {[gets $fileid line] >= 0} {
+ if { [string compare $action fill] == 0 } {
+ if { [regexp $U_begrgx $line ignore UD status ] } {
+ set TLOC($UD) {}
+ } elseif {[regexp $F_begrgx $line ignore status name version ] } {
+ set l $TLOC($UD)
+ set TLOC($UD) [lappend l [list $name $version]]
+ } elseif {[regexp {^Report [0-9]*_.*} $line] } {
+ break
+ }
+
+ } else {
+ if {[regexp {^Report [0-9]*_.*} $line] } {
+ break
+ } else {
+ lappend TEXTE $line
+ }
+ }
+ }
+ }
+
+ scanfile $R_begheader $fileid
+ scancontext delete $R_begheader
+ close $fileid
+ if {[string compare $action fill] == 0} {
+ return $REPORT
+ } else {
+ return $TEXTE
+ }
+}
+#;>
+#; Retourne la string de file entre n1 et n2
+#;<
+proc wokIntegre:Journal:PickMultReport { file n1 n2 } {
+ if { $n1 > $n2 } {
+ return {}
+ }
+ if [ catch { set fileid [open $file r] } err ] {
+ msgprint -c WOKVC -e "$err"
+ return {}
+ }
+ set lines [split [read $fileid] \n]
+ close $fileid
+ set ret {}
+ set fillnow 0
+ foreach line $lines {
+ if {[regexp {^Report ([0-9]*)_rep } $line all num] } {
+ if { $num >= $n1 && $num <= $n2 } {
+ lappend ret $line
+ set fillnow 1
+ } elseif { $num > $n2 } {
+ break
+ }
+ } else {
+ if { $fillnow } {
+ lappend ret $line
+ }
+ }
+ }
+ return $ret
+}
+#;>
+# Appel function en lui passant une tranche de journal.
+# function a 2 arguments: function { string table }
+# <string> est la concatenation de tous les commentaires
+# Table est une map indexe par le nom.type de l'UD. Chaque entry contient la liste
+# (non purgee) des fichiers modifies avec leur numero de version. (upvar)
+#;<
+proc wokIntegre:Journal:Slice { journal n1 n2 function args } {
+ catch {unset TLOC}
+ set comments {}
+ set llstr [wokIntegre:Journal:PickMultReport $journal $n1 $n2]
+ foreach line $llstr {
+ set lili [split $line]
+ set head [lindex $lili 0]
+ set updt [lindex $lili 3]
+ set flag [lindex $lili 4]
+ if { "$head" == "Report" || "$head" == "--" } {
+ append comments $line \n
+ } elseif { "$updt" == "(Updated)" } {
+ set unit [lindex $lili 2]
+ } elseif { "$flag" == "Modified" } {
+ set l {}
+ if [info exists TLOC($unit)] { set l $TLOC($unit) }
+ lappend l [list $flag [lindex [split $line :] 1]]
+ set TLOC($unit) $l
+ } elseif { "$flag" == "Added" } {
+ set l {}
+ if [info exists TLOC($unit)] { set l $TLOC($unit) }
+ lappend l [list $flag [lindex [split $line :] 1]]
+ set TLOC($unit) $l
+ } elseif { "$flag" == "Deleted" } {
+ set l {}
+ if [info exists TLOC($unit)] { set l $TLOC($unit) }
+ lappend l [list $flag [lindex [split $line :] 1]]
+ set TLOC($unit) $l
+ }
+ }
+ return [$function $comments TLOC $args]
+}
+#;>
+# Liste le nom de tous les reports enregistre dans le journal
+#;<
+proc wokIntegre:Journal:ListReport { file } {
+ ;#Report 6_rep - 13/03/96 14:25 from workbench Yan (yfokon)
+
+ if [ catch { set fileid [open $file r] } ] {
+ return {}
+ }
+
+ set R_begrgx {^Report ([0-9]+)_.* - ([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+) from workbench ([^ ]*) ([^ ]*)}
+ set R_begheader [scancontext create]
+ set lret {}
+ scanmatch $R_begheader $R_begrgx {
+ lappend lret [list $matchInfo(submatch0) $matchInfo(submatch1) $matchInfo(submatch2) $matchInfo(submatch3) ]
+ }
+ scanfile $R_begheader $fileid
+ scancontext delete $R_begheader
+ close $fileid
+ return $lret
+}
+;#
+;# retourne la date du report num sous forme comparable.
+;#
+proc wokIntegre:Journal:ReportDate { file num} {
+ ;#Report 6_rep - 13/03/96 14:25 from workbench Yan (yfokon)
+
+ if [ catch { set fileid [open $file r] } ] {
+ return {}
+ }
+
+ set R_begrgx "^Report ${num}_rep - (\[0-9\]+/\[0-9\]+/\[0-9\]+ \[0-9\]+:\[0-9\]+) from workbench (\[^ \]*) (\[^ \]*)"
+ set R_begheader [scancontext create]
+ set dret {}
+ scanmatch $R_begheader $R_begrgx {
+ set dret $matchInfo(submatch0)
+ set dret [wokUtils:TIME:dpe $matchInfo(submatch0)]
+ }
+ scanfile $R_begheader $fileid
+ scancontext delete $R_begheader
+ close $fileid
+ return $dret
+}
+
+#;>
+# Cree un journal tout neuf et renomme le vieux en num1-num2.jnl
+#;<
+proc wokIntegre:Journal:Purge { fshop } {
+ set jnl [wokIntegre:Journal:GetName $fshop]
+ if [file exists $jnl] {
+ set lrep [wokIntegre:Journal:ListReport $jnl]
+ set num1 [lindex [lindex $lrep 0] 0]
+ set num2 [lindex [lindex $lrep end] 0]
+ set savjnl [file dirname $jnl]/${num1}-${num2}.jnl
+ frename $jnl $savjnl
+ msgprint -c WOKVC -i "Creating file $jnl"
+ wokUtils:FILES:ListToFile {} $jnl
+ chmod 0777 $jnl
+ return $savjnl
+ } else {
+ return {}
+ }
+}
+#;>
+# Retourne la liste des a-b.jnl dans l'ordre correct pour etre concatene.
+#;<
+proc wokIntegre:Journal:List { fshop } {
+ set dir [file dirname [wokIntegre:Journal:GetName $fshop]]
+ set l {}
+ set deb 1
+ while { 1 } {
+ set fxt [glob -nocomplain $dir/${deb}-*.jnl]
+ if { $fxt != {} } {
+ set deb [expr { [lindex [split [file root [file tail $fxt]] -] 1] +1 }]
+ lappend l $fxt
+ } else {
+ break
+ }
+ }
+ return $l
+}
+#;>
+# Reconstruit le journal complet de fshop dans path.
+#;<
+proc wokIntegre:Journal:Assemble { path fshop {liste {}} } {
+ if [file exists $path] {
+ if [catch { unlink $path } err] {
+ msgprint -c WOKVC -e "Assemble error: $err"
+ return
+ }
+ }
+ if { $liste == {} } {
+ wokUtils:FILES:concat $path \
+ [concat \
+ [wokIntegre:Journal:List $fshop] \
+ [wokIntegre:Journal:GetName $fshop] ]
+ } else {
+ wokUtils:FILES:concat $path $liste
+ }
+ return
+}
+#;>
+# Retourne le path du bout de journal contenant le report <num>
+#;<
+proc wokIntegre:Journal:GetSlice { num fshop } {
+ set ljnl [wokIntegre:Journal:List $fshop]
+ foreach fxt $ljnl {
+ set lll [split [file root [file tail $fxt]] -]
+ if { $num >= [lindex $lll 0] && $num <= [lindex $lll 1] } {
+ return $fxt
+ }
+ }
+ return [wokIntegre:Journal:GetName $fshop]
+}
+#;>
+# Retourne la liste des pathes des bouts de journal contenant les reports <num1> a <num2>
+#;<
+proc wokIntegre:Journal:GetBigSlice { num1 num2 fshop } {
+ set ljnl [wokIntegre:Journal:List $fshop]
+ foreach fxt $ljnl {
+ set lll [split [file root [file tail $fxt]] -]
+ if { $num1 >= [lindex $lll 0] && $num1 <= [lindex $lll 1] } {
+ set i1 [lsearch $ljnl $fxt]
+ break
+ }
+ }
+
+ foreach fxt $ljnl {
+ set lll [split [file root [file tail $fxt]] -]
+ if { $num2 >= [lindex $lll 0] && $num2 <= [lindex $lll 1] } {
+ set i2 [lsearch $ljnl $fxt]
+ break
+ }
+ }
+
+ if { [info exists i1] && [info exists i2] } {
+ return [lrange $ljnl $i1 $i2]
+ } elseif { [info exists i1] } {
+ return [concat [lrange $ljnl $i1 end] [wokIntegre:Journal:GetName $fshop]]
+ } elseif { [info exists i2] } {
+ return {}
+ } else {
+ return {}
+ }
+
+}
+# ((((((((((((((((MARK))))))))))))))))
+#
+#;>
+# Retourne le path du fichier mark, associe a journal si create = 1 le cree s'il n'existe pas.
+#;<
+proc wokIntegre:Mark:GetTableName { journal {create 0} } {
+ set diradm [file dirname $journal]/mark
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating marks file in [file dirname $diradm]"
+ catch { mkdir -path [file dirname $diradm] }
+ wokUtils:FILES:ListToFile {} $diradm
+ chmod 0777 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# Associe un commentaire a une mark
+#;<
+proc wokIntegre:Mark:SetComment { journal option mark_name comment } {
+ switch -- $option {
+ string {
+ set l $comment
+ }
+ file {
+ set l [wokUtils:FILES:FileToList $comment]
+ }
+ }
+ wokUtils:FILES:ListToFile $l [file dirname $journal]/${mark_name}.cmtmrk
+ return
+}
+#;>
+# Retourne le commentaire associe a une mark
+#;<
+proc wokIntegre:Mark:GetComment { journal mark_name } {
+ return [wokUtils:FILES:FileToList [file dirname $journal]/${mark_name}.cmtmrk]
+}
+#;>
+# Retourne la liste des marks associees a journal
+#;<
+proc wokIntegre:Mark:Dump { journal {bydate 0} } {
+ set l [wokUtils:FILES:FileToList [wokIntegre:Mark:GetTableName $journal]]
+ if { $bydate == 0 } {
+ return [lsort -command wokIntegre:Mark:sbyindex $l]
+ } else {
+ return [lsort -command wokIntegre:Mark:sbydate $l]
+ }
+}
+#;>
+# Retourne la liste des marks associees a journal
+#;<
+proc wokIntegre:Mark:NiceDump { journal table } {
+ upvar $table TLOC
+ catch {unset TLOC}
+ foreach x [wokUtils:FILES:FileToList [wokIntegre:Mark:GetTableName $journal]] {
+ set TLOC([lindex $x 0]) [lindex $x 1]
+ }
+ return
+}
+#;>
+#
+#;<
+proc wokIntegre:Mark:sbydate { a b } {
+ set n1 [lindex [split [lindex $a 1] ,] 1]
+ set n2 [lindex [split [lindex $b 1] ,] 1]
+ return [expr $n1 -$n2]
+}
+proc wokIntegre:Mark:sbyindex { a b } {
+ set n1 [lindex [split [lindex $a 1] ,] 0]
+ set n2 [lindex [split [lindex $b 1] ,] 0]
+ return [expr $n1 -$n2]
+}
+#;>
+# Retourne l'index associe a la marque mark {} si elle n'existe pas.
+#;<
+proc wokIntegre:Mark:Get { journal mark } {
+ set f [wokIntegre:Mark:GetTableName $journal]
+ if { $f != {} } {
+ foreach e [wokUtils:FILES:FileToList $f] {
+ if { $mark == [lindex $e 0] } {
+ return [lindex [split [lindex $e 1] ,] 0]
+ }
+ }
+ }
+ return {}
+}
+#;>
+# Retourne la mark posee le plus recemment dans le journal.
+#;<
+proc wokIntegre:Mark:Last { journal } {
+ set mx 0
+ set str [list {} {} ]
+ foreach x [wokUtils:FILES:FileToList [wokIntegre:Mark:GetTableName $journal]] {
+ if { [regexp {([-A-Za-z][-A-Za-z0-9]*) ([0-9]+),([0-9]+)} $x all mark index date] } {
+ if { $date >= $mx } {
+ set mx $date
+ set str [list $mark $index]
+ }
+ }
+ }
+ return $str
+}
+;#
+;# Retourne la date pointee par la marque
+;#
+proc wokIntegre:Mark:Date { journal mark } {
+ set nbr [wokIntegre:Mark:Get $journal $mark]
+ return $nbr
+}
+#;>
+# Ajoute une marque a la liste de celle associee a journal. Ecrase la precedente
+# 2 marks differentes peuvent pointer sur le meme index. Pas l'inverse
+# Pour mettre une mark a la fin du journal index = [expr [wokIntegre:Number:Get] -1]
+#;<
+proc wokIntegre:Mark:Set { journal mark index } {
+ catch {unset tmark}
+ set f [wokIntegre:Mark:GetTableName $journal]
+ wokUtils:LIST:ListToMap tmark [wokUtils:FILES:FileToList $f]
+ set tmark($mark) ${index},[getclock]
+ wokUtils:FILES:copy $f ${f}-previous
+ wokUtils:FILES:ListToFile [wokUtils:LIST:MapToList tmark] $f
+ return
+}
+#;>
+# Detruit une marque
+#;<
+proc wokIntegre:Mark:Del { journal mark } {
+ catch {unset tmark}
+ set f [wokIntegre:Mark:GetTableName $journal]
+ wokUtils:LIST:ListToMap tmark [wokUtils:FILES:FileToList $f]
+ catch { unset tmark($mark) }
+ wokUtils:FILES:copy $f ${f}-previous
+ wokUtils:FILES:ListToFile [wokUtils:LIST:MapToList tmark] $f
+ return
+}
+#;>
+# traite un index dans le journal string = s1:s2 avec:
+# s1 == <entier>|<mark>|LAST ( la marque posee le plus recemment )
+# s2 == <entier>|<mark>|END ( la fin du journal )
+# mark doit commencer par une lettre et ne pas contenir ":"
+#;<
+proc wokIntegre:Mark:Scan { jnl string } {
+ set l [split $string :]
+ if { [llength $l] == 2 } {
+ return [list [wokIntegre:Mark:Trn $jnl [lindex $l 0]] [wokIntegre:Mark:Trn $jnl [lindex $l 1]]]
+ } else {
+ return [list {} {}]
+ }
+}
+#;>
+#
+#;<
+proc wokIntegre:Mark:Trn { journal m } {
+ set digit {^[0-9]+$}
+ set regmark {^[-A-Za-z][-A-Za-z0-9]*$}
+ set r {}
+ if { [regexp -- $digit $m] } {
+ set r $m
+ } else {
+ if { [wokIntegre:Mark:Check $m] } {
+ if { "$m" == "END" } {
+ set r [wokIntegre:Number:Get]
+ } elseif { "$m" == "LAST" } {
+ set r [lindex [wokIntegre:Mark:Last $journal] 1]
+ } elseif { [regexp -- $regmark $m] } {
+ set r [wokIntegre:Mark:Get $journal $m]
+ }
+ }
+ }
+ return $r
+}
+#;>
+#
+#;<
+proc wokIntegre:Mark:Check { s } {
+ set regmark {^[-A-Za-z][-A-Za-z0-9]*$}
+ set e1 [expr { "$s" == "END"} ]
+ set e2 [expr { "$s" == "LAST"} ]
+ set e3 [expr { [regexp -- $regmark $s]} ]
+ return [expr $e1 || $e2 || $e3 ]
+}
+
+#;>
+# Place texte dans le fichier scoop ( derniere integration faite)
+# si texte = {} retourne le nom du scoop.
+#;<
+proc wokIntegre:Scoop:Create { fshop {texte {}} } {
+ set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/scoop.jnl
+ if { $texte != {} } {
+ wokUtils:FILES:copy $texte $diradm
+ chmod 0777 $diradm
+ }
+ return $diradm
+}
+#;>
+# Place texte dans le fichier scoop ( derniere integration faite)
+# si texte = {} retourne le nom du scoop.
+#;<
+proc wokIntegre:Scoop:Read { fshop {option header} } {
+ switch -- $option {
+
+ header {
+ set scoop [wokIntegre:Scoop:Create $fshop]
+ if [file exists $scoop] {
+ return [lindex [wokUtils:FILES:FileToList $scoop] 0]
+ } else {
+ return {}
+ }
+ }
+
+ }
+}
+;#############################################################
--- /dev/null
+;#
+;# Appele quand on browse la hlist wprepare
+;#
+proc wokDisplayCook { item w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+
+ set litm [split $item ^]
+ if { [llength $litm] == 2 } {
+ set data [$IWOK_WINDOWS($w,hlist) info data $item]
+ set item [lindex $litm 1]
+ } else {
+ return
+ }
+
+ set unit [$IWOK_WINDOWS($w,hlist) info parent [$IWOK_WINDOWS($w,hlist) info anchor]]
+
+ set flag [lindex $item 0]
+ set name [lindex $item 1]
+ set d1 [lindex $item 2]
+ set twb [wokgetWB $d1 $unit $IWOK_WINDOWS($w,shop) $IWOK_WINDOWS($w,LWB)]
+
+ if { [lindex $data 0] } {
+ $IWOK_WINDOWS($w,warbut) subwidget warwhy configure -state active -fg orange
+ } else {
+ $IWOK_WINDOWS($w,warbut) subwidget warwhy configure -state disabled
+ $IWOK_WINDOWS($w,warbut) subwidget warget configure -state disabled
+ }
+
+
+ if { $IWOK_GLOBALS(comment,entered) } {
+ set IWOK_GLOBALS(comment,string) [wokTextToString $IWOK_WINDOWS($w,text)]
+ set IWOK_GLOBALS(comment,entered) 0
+ }
+
+ [$IWOK_WINDOWS($w,button) subwidget search] configure -state active
+
+ switch -- $flag {
+ + {
+ wokReadFile $IWOK_WINDOWS($w,text) $d1/$name
+ $IWOK_WINDOWS($w,label) configure -text \
+ "ADDED: File ${twb}:${name}" -fg yellow
+ [$IWOK_WINDOWS($w,button) subwidget editcopy] configure -state active
+ [$IWOK_WINDOWS($w,button) subwidget xdiff] configure -state disabled
+ eval "proc wokeditcopy { args } {wokEDF:EditFile $d1/$name}"
+ }
+
+ - {
+ wokReadFile $IWOK_WINDOWS($w,text) $d1/$name
+ $IWOK_WINDOWS($w,label) configure -text \
+ "REMOVED: File ${twb}:${name}" -fg yellow
+ [$IWOK_WINDOWS($w,button) subwidget editcopy] configure -state active
+ [$IWOK_WINDOWS($w,button) subwidget xdiff] configure -state disabled
+ eval "proc wokeditcopy { args } {wokEDF:EditFile $d1/$name}"
+ }
+
+ = {
+ wokReadFile $IWOK_WINDOWS($w,text) $d1/$name
+ $IWOK_WINDOWS($w,label) configure -text \
+ "NOT MODIFIED: File ${twb}:${name}" -fg yellow
+ [$IWOK_WINDOWS($w,button) subwidget editcopy] configure -state active
+ [$IWOK_WINDOWS($w,button) subwidget xdiff] configure -state disabled
+ eval "proc wokeditcopy { args } {wokEDF:EditFile $d1/$name}"
+ }
+
+ # {
+ [$IWOK_WINDOWS($w,button) subwidget editcopy] configure -state disabled
+ set d2 [lindex $item 3]
+ set twb2 [wokgetWB $d2 $unit $IWOK_WINDOWS($w,shop) $IWOK_WINDOWS($w,LWB)]
+ wokDiffInText $IWOK_WINDOWS($w,text) $d2/$name $d1/$name
+ if { [set xdiff [wokUtils:FILES:MoreDiff]] != {} } {
+ [$IWOK_WINDOWS($w,button) subwidget xdiff] configure -state active
+ eval "proc wokxdiff { args } {exec $xdiff $d2/$name $d1/$name &}"
+ }
+ $IWOK_WINDOWS($w,label) configure -text \
+ "File ${twb2}:${name} < > ${twb}:${name}" -fg yellow
+
+ }
+ }
+ return
+}
+
+proc wokgetWB { dirpath ud shop lwb } {
+ foreach wb $lwb {
+ if { [wokinfo -x ${shop}:${wb}:$ud] } {
+ if { [string trimright [wokinfo -p source:. ${shop}:$wb:$ud] /.] == "$dirpath" } {
+ return $wb
+ }
+ }
+ }
+ return {}
+}
+#
+# Edition d'un report depuis IWOK. Seuls les fichiers sont traites.
+#
+proc WOKCOOK { opt args } {
+ global IWOK_GLOBALS
+
+ set H $IWOK_GLOBALS(CookHlist)
+
+ switch $opt {
+
+ files {
+ set e [lindex $args 2]
+ set d1 [lindex $args 3]
+ set udname $IWOK_GLOBALS(CookHlist,Unit)
+ set key ${e}:$IWOK_GLOBALS(CookHlist,Key)
+ set suspect [info exists IWOK_GLOBALS(CookHlist,dupl,list,$key)]
+ switch -- [lindex $args 0] {
+ + {
+ if { $suspect } {
+ set IWOK_GLOBALS(CookHlist,dupl,suspect) 1
+ $H add ${udname}^[list + $e $d1] -text [format "+ %-30s" $e] \
+ -data [list 1 $IWOK_GLOBALS(CookHlist,dupl,list,$key)] -itemtype text \
+ -style $IWOK_GLOBALS(CookHlist,dupl,style)
+ } else {
+ $H add ${udname}^[list + $e $d1] -text [format "+ %-30s" $e] \
+ -data [list 0 {}] -itemtype text
+ }
+ }
+ - {
+ if { $suspect } {
+ set IWOK_GLOBALS(CookHlist,dupl,suspect) 1
+ $H add ${udname}^[list - $e $d1] -text [format "- %-30s" $e] \
+ -data [list 1 $IWOK_GLOBALS(CookHlist,dupl,list,$key)] -itemtype text \
+ -style $IWOK_GLOBALS(CookHlist,dupl,style)
+ } else {
+ $H add ${udname}^[list - $e $d1] -text [format "- %-30s" $e] \
+ -data [list 0 {}] -itemtype text
+ }
+ }
+ = {
+ if { $suspect } {
+ set IWOK_GLOBALS(CookHlist,dupl,suspect) 1
+ $H add ${udname}^[list = $e $d1 [lindex $args 4]] -text [format "= %-30s" $e] \
+ -data [list 1 $IWOK_GLOBALS(CookHlist,dupl,list,$key)] -itemtype text \
+ -style $IWOK_GLOBALS(CookHlist,dupl,style)
+ } else {
+ $H add ${udname}^[list = $e $d1 [lindex $args 4]] -text [format "= %-30s" $e] \
+ -data [list 0 {}] -itemtype text
+ }
+ set IWOK_GLOBALS(scratch) 1
+
+ }
+ # {
+ if { $suspect } {
+ set IWOK_GLOBALS(CookHlist,dupl,suspect) 1
+ $H add ${udname}^[list # $e $d1 [lindex $args 4]] -text [format "# %-30s" $e] \
+ -data [list 1 $IWOK_GLOBALS(CookHlist,dupl,list,$key)] -itemtype text \
+ -style $IWOK_GLOBALS(CookHlist,dupl,style)
+ } else {
+ $H add ${udname}^[list # $e $d1 [lindex $args 4]] -text [format "# %-30s" $e] \
+ -data [list 0 {}] -itemtype text
+ }
+ }
+ }
+ }
+
+ uheader {
+ regexp {(.*)\.(.*)} [lindex $args 0] all udname type
+ $H add $udname -itemtype imagetext -text $udname \
+ -style $IWOK_GLOBALS(CookHlist,dupl,ustyle) -image [tix getimage $type]
+ set IWOK_GLOBALS(CookHlist,Unit) ${udname}
+ set IWOK_GLOBALS(CookHlist,Key) ${udname}.$IWOK_GLOBALS(CookHlist,stype,$type)
+ $H see $udname
+ }
+
+ }
+ update
+}
+
+proc wokPrepareExit { w } {
+ global IWOK_GLOBALS
+ destroy $w
+ foreach e [array names IWOK_GLOBALS CookHlist,*] {
+ catch { unset IWOK_GLOBALS($e) }
+ }
+ wokButton delw [list prepare $w]
+ return
+}
+
+proc wokPrepare { {loc {}} {les_uds {}} } {
+ global IWOK_GLOBALS
+ global IWOK_WINDOWS
+
+
+
+ if { $loc == {} } {
+ set verrue [wokCWD readnocell]
+ } else {
+ set verrue $loc
+ }
+ if ![wokinfo -x $verrue] {
+ wokDialBox .wokcd {Unknown location} "Location $verrue is unknown" {} -1 OK
+ return
+ }
+ set shop [wokinfo -s $verrue]
+ set wb [wokinfo -n [wokinfo -w $verrue]]
+
+
+ set w [wokTPL wprepare${verrue}]
+ if [winfo exists $w ] {
+ wm deiconify $w
+ raise $w
+ return
+ }
+
+ toplevel $w
+ wm title $w "Comparing workbenches in $shop"
+ wokButton setw [list prepare $w]
+
+ wm geometry $w 960x720+461+113
+
+ foreach type $IWOK_GLOBALS(ucreate-P) {
+ set tn [lindex $type 1]
+ set IWOK_GLOBALS(CookHlist,stype,$tn) [lindex $type 0]
+ }
+ set IWOK_WINDOWS($w,WBFils) $wb
+ set IWOK_WINDOWS($w,LWB) [w_info -A ${shop}:$wb]
+ if { [llength $IWOK_WINDOWS($w,LWB)] > 1 } {
+ set IWOK_WINDOWS($w,WBPere) [lindex $IWOK_WINDOWS($w,LWB) 1]
+ } else {
+ set IWOK_WINDOWS($w,WBPere) $wb
+ }
+
+ set func1 wokHliAdd
+ set func2 wokHliDel
+ set function wokDisplayCook
+
+ menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0
+ menu $w.file.m
+ $w.file.m add command -label "Close " -underline 1 -command [list wokPrepareExit $w]
+ menubutton $w.admin -menu $w.admin.m -text Admin -underline 0 -takefocus 0
+ menu $w.admin.m
+
+ $w.admin.m add command -label "Check for init" -underline 1 -command [list wokPrepareCheck $w]
+ $w.admin.m entryconfigure 1 -state disabled
+ $w.admin.m configure -postcommand [list wokPostCheck $w]
+
+ menubutton $w.help -menu $w.help.m -text Help -underline 0 -takefocus 0
+ menu $w.help.m
+ $w.help.m add command -label "Help" -underline 1 -command [list wokPrepareHelp $w]
+
+ frame $w.top -relief sunken -bd 1
+ label $w.lab -relief sunken
+
+ tixScrolledHList $w.h1 -width 8c ; set hlist1 [$w.h1 subwidget hlist]
+ set locfunc1 ${func1}_$w ; set body {$item} ; eval "proc $locfunc1 { item } { $func1 $body $w}"
+ $hlist1 config -separator ^ -drawbranch 0 -browsecmd $locfunc1 -selectmode single
+
+ tixScrolledHList $w.h2 -width 8c ; set hlist2 [$w.h2 subwidget hlist]
+ set locfunc2 ${func2}_$w ; set body {$item} ; eval "proc $locfunc2 { item } { $func2 $body $w}"
+ $hlist2 config -separator ^ -drawbranch 0 -browsecmd $locfunc2 -selectmode single
+
+ tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50
+ pack $w.top.pane -side top -expand yes -fill both -padx 1 -pady 1
+
+ set p1 [$w.top.pane add list -min 70 -size 200]
+ set p2 [$w.top.pane add text -min 70]
+
+ tixScrolledHList $p1.list ; set hlist [$p1.list subwidget hlist]
+ set locfunc ${function}_$w ; set body {$item} ; eval "proc $locfunc { item } { $function $body $w}"
+ $hlist config -font $IWOK_GLOBALS(font) -separator ^ -drawbranch 0 -browsecmd $locfunc -selectmode single
+ tixScrolledText $p2.text ; $p2.text subwidget text config -font $IWOK_GLOBALS(font)
+ set texte [$p2.text subwidget text]
+
+ pack $p1.list -expand yes -fill both -padx 1 -pady 1
+ pack $p2.text -expand yes -fill both -padx 1 -pady 1 -padx 3
+
+ frame $w.wbs -relief sunken -bd 1
+ tixLabelEntry $w.wbs.mas -label "Workbench 1" -labelside left -options {
+ label.anchor n
+ }
+
+ tixLabelEntry $w.wbs.rev -label "Workbench 2" -labelside left -options {
+ label.anchor n
+ }
+
+ tixForm $w.wbs.mas -top 0 -left 0 -right -0
+ tixForm $w.wbs.rev -top $w.wbs.mas -left 0 -right -0
+ $w.wbs.mas subwidget entry configure -textvariable IWOK_WINDOWS($w,WBPere)
+ $w.wbs.rev subwidget entry configure -textvariable IWOK_WINDOWS($w,WBFils)
+
+ tixButtonBox $w.but -orientation horizontal -relief raised -padx 0 -pady 0
+
+ set buttons [list \
+ {addall "Add all" active wokHliAddall} \
+ {delall "Del all" active wokDelall} \
+ {prepare "Compare" active wokRunPrepar} \
+ {exclude "Exclude" disabled wokExcludeItem} \
+ {hide "Hide=" disabled wokHideEq} \
+ {rmeq "rm =" disabled wokrmEq} \
+ {editcopy "To Editor" disabled wokeditcopy} \
+ {search "Search" disabled wokeditsearch} \
+ {xdiff "More Diff" disabled wokxdiff} \
+ {comment "Comments" disabled wokEnterComment} \
+ {saveas "Save " disabled wokSaveas} \
+ ]
+
+ foreach b $buttons {
+ $w.but add [lindex $b 0] -text [lindex $b 1]
+ [$w.but subwidget [lindex $b 0]] configure -state [lindex $b 2] -command [list [lindex $b 3] $w]
+ }
+
+ tixButtonBox $w.warbut -orientation horizontal -relief flat -padx 0 -pady 0
+
+ set warbut [list \
+ {warshow "Show warnings" disabled wokDupEntryShow} \
+ {warwhy "Queue diff" disabled wokDupEntryWhy} \
+ {warget "Get from Queue" disabled wokDupEntryGet} \
+ ]
+
+ foreach b $warbut {
+ $w.warbut add [lindex $b 0] -text [lindex $b 1]
+ [$w.warbut subwidget [lindex $b 0]] configure \
+ -state [lindex $b 2] -command [list [lindex $b 3] $w] -width 11
+ }
+
+ if [wokStore:Queue:Enabled $shop $IWOK_WINDOWS($w,WBPere)] {
+ set trigger [wokStore:Trigger:Exists $shop]
+ button $w.stor -text "Store"
+ $w.stor configure -state disabled -command [list wokStoreThat $w]
+
+ tixForm $w.file ; tixForm $w.admin -left $w.file
+ if { $trigger != {} } {
+ menubutton $w.shrt -menu $w.shrt.m -text Trigger -underline 0 -takefocus 0
+ menu $w.shrt.m
+ $w.shrt.m add command -label "Show content" -underline 0 -command [list wokShowTrig $w $trigger]
+ tixForm $w.shrt -left $w.admin
+ }
+
+ tixForm $w.help -right -2
+ tixForm $w.h1 -top $w.file -left 2 -right %28
+ tixForm $w.wbs -top $w.file -left $w.h1 -right $w.h2
+ tixForm $w.h2 -top $w.file -right -2 -left %78
+ tixForm $w.but -top $w.h1 -left 2
+
+ set IWOK_WINDOWS($w,trig) 0
+
+ if { $trigger != {} } {
+ checkbutton $w.trig -text "Trigger" -variable IWOK_WINDOWS($w,trig)
+ $w.trig configure -state disabled
+ tixForm $w.trig -top $w.h1 -left $w.but
+ tixForm $w.stor -top $w.h1 -left $w.trig -right -1
+ } else {
+ tixForm $w.stor -top $w.h1 -left $w.but -right -1
+ }
+ } else {
+ button $w.stor -text "Update $IWOK_WINDOWS($w,WBPere)"
+ $w.stor configure -state disabled -command [list wokUpdateThat $w]
+ tixForm $w.file
+ tixForm $w.admin -left $w.file
+ tixForm $w.help -right -2
+ tixForm $w.h1 -top $w.file -left 2 -right %32
+ tixForm $w.wbs -top $w.file -left $w.h1 -right $w.h2
+ tixForm $w.h2 -top $w.file -right -2 -left %68
+ tixForm $w.but -top $w.h1 -left 2
+ tixForm $w.stor -top $w.h1 -left $w.but -right -1
+ }
+
+ tixForm $w.top -top $w.but -left 2 -right -2 -bottom $w.warbut
+ tixForm $w.warbut -bottom -0 -left %66 -right %100
+ tixForm $w.lab -left 0 -bottom -0 -right $w.warbut
+
+ set IWOK_WINDOWS($w,menu) $w.file.m
+ set IWOK_WINDOWS($w,admin) $w.admin.m
+ set IWOK_WINDOWS($w,label) $w.lab
+ set IWOK_WINDOWS($w,hlist) $hlist
+ set IWOK_WINDOWS($w,text) $texte
+ set IWOK_WINDOWS($w,hlist1) $hlist1
+ set IWOK_WINDOWS($w,hlist2) $hlist2
+ set IWOK_WINDOWS($w,button) $w.but
+ set IWOK_WINDOWS($w,warbut) $w.warbut
+ set IWOK_WINDOWS($w,actrig) $w.trig
+ set IWOK_WINDOWS($w,store) $w.stor
+ set IWOK_WINDOWS($w,shop) $shop
+ set IWOK_WINDOWS($w,qroot) [wokStore:Report:GetRootName $shop 0]
+
+ set allUnits [wokPreparInitFils $w $wb]
+ wokPreparInitPere $w $wb
+
+ if { $les_uds != {} } {
+ wokHliAdd $les_uds $w
+ }
+
+ update
+ set IWOK_GLOBALS($w,popup) [tixPopupMenu $w.popmenu -title "Select"]
+ $w.popmenu subwidget menubutton configure -font $IWOK_GLOBALS(font)
+ set IWOK_GLOBALS($w,popup,menu) [$IWOK_GLOBALS($w,popup) subwidget menu]
+ $IWOK_GLOBALS($w,popup,menu) configure -font $IWOK_GLOBALS(font)
+ foreach t [linsert $IWOK_GLOBALS(ucreate-P) 0 [list All All] ] {
+ $IWOK_GLOBALS($w,popup,menu) add command -label [lindex $t 1] \
+ -command [list wokPreparFilter $hlist1 [lindex $t 1] $allUnits]
+ }
+
+ $IWOK_GLOBALS($w,popup) bind $hlist1
+
+ bind $IWOK_WINDOWS($w,hlist) <Control-f> {
+ wokGetDoublon %W
+ }
+
+ bind $IWOK_WINDOWS($w,hlist) <Control-x> {
+ catch {
+ set next [%W info next [%W info anchor]]
+ %W delete entry [%W info anchor]
+ %W anchor set $next
+ unset next
+ }
+ }
+
+ bind $IWOK_WINDOWS($w,hlist) <Control-k> {
+ catch {
+ set next [%W info next [%W info anchor]]
+ %W delete entry [%W info anchor]
+ %W anchor set $next
+ unset next
+ }
+ }
+
+ bind [$w.wbs.mas subwidget entry] <Return> {
+ wokPreparInitPere [winfo toplevel %W] [%W get]
+ update
+ }
+
+ bind [$w.wbs.rev subwidget entry] <Return> {
+ wokPreparInitFils [winfo toplevel %W] [%W get]
+ update
+ }
+
+ ;#bind $w <Destroy> { if [winfo exists %W] { wokPrepareExit %W }}
+
+ return
+}
+proc wokGetDoublon { hli } {
+ set item [$hli info anchor] ;#WOKTclLib^# Mkf.tcl //wok/src/WOKTclLib /adv_23/WOK/ef/src/WOKTclLib
+ set data [$hli info data $item]
+ set suspect [lindex $data 0]
+ if { $suspect } {
+ puts "suspect"
+ } else {
+ puts "ok"
+ }
+ return
+}
+
+proc wokeditsearch { w } {
+ global IWOK_WINDOWS
+ wokSEA $IWOK_WINDOWS($w,text)
+ return
+}
+
+proc wokPostCheck { w } {
+ global IWOK_WINDOWS
+ if { [llength [$IWOK_WINDOWS($w,hlist2) info children]] != 0 } {
+ $IWOK_WINDOWS($w,admin) entryconfigure 1 -state active
+ } else {
+ $IWOK_WINDOWS($w,admin) entryconfigure 1 -state disabled
+ }
+ return
+}
+
+proc wokClearHlist { w listh } {
+ global IWOK_WINDOWS
+ foreach hl $listh {
+ $IWOK_WINDOWS($w,$hl) delete all
+ }
+ return
+}
+proc wokDelall { w } {
+ global IWOK_WINDOWS
+ wokHliDelall $w
+ wokClearHlist $w hlist
+ return
+}
+
+proc wokPreparInitPere { w wb } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set fwb $IWOK_WINDOWS($w,shop):$wb
+ if [wokinfo -x $fwb] {
+ wokActiveStore $w disabled
+ wokClearHlist $w [list hlist hlist2]
+ } else {
+ wokClearHlist $w [list hlist hlist1 hlist2]
+ wokDialBox .notawb {Not a workbench} "The workbench $fwb does not exist" {} -1 OK
+ }
+ return
+}
+;#
+;# Init de la hlist de gauche avec les Units du fils
+;#
+proc wokPreparInitFils { w wb } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set allUnits {}
+ set fwb $IWOK_WINDOWS($w,shop):$wb
+ set IWOK_WINDOWS($w,LWB) [w_info -A $fwb]
+ if [wokinfo -x $fwb] {
+ $IWOK_WINDOWS($w,hlist1) delete all
+ foreach i [ lsort [w_info -a $fwb]] {
+ $IWOK_WINDOWS($w,hlist1) add $i -itemtype imagetext \
+ -text [lindex $i 1] -image $IWOK_GLOBALS(image,[lindex $i 0])
+ lappend allUnits [list [lindex $i 0] [lindex $i 1] $IWOK_GLOBALS(image,[lindex $i 0])]
+ }
+ wokClearHlist $w [list hlist hlist2]
+ } else {
+ wokDialBox .notawb {Not a workbench} "The workbench $fwb does not exist" {} -1 OK
+ }
+ return $allUnits
+}
+
+proc wokPreparFilter { hlist t allUnits } {
+ $hlist delete all
+ foreach i $allUnits {
+ set type [lindex $i 0]
+ set name [lindex $i 1]
+ set image [lindex $i 2]
+ if { "$t" != "All" } {
+ if { "$type" == "$t" } {
+ $hlist add [list $type $name] -itemtype imagetext -text $name -image $image
+ }
+ } else {
+ $hlist add [list $type $name] -itemtype imagetext -text $name -image $image
+ }
+ }
+ return
+}
+proc wokDupEntryGet { w } {
+ global IWOK_WINDOWS
+ set file $IWOK_WINDOWS($w,warfile)
+ set U $IWOK_WINDOWS($w,warunit)
+ set dest [wokinfo -p source:. $IWOK_WINDOWS($w,WBFils):$U]
+ if [file writable $dest] {
+ wokUtils:FILES:copy $file $dest/queue,[file tail $file]
+ $IWOK_WINDOWS($w,label) configure -text "File $dest/queue,[file tail $file] created." -fg orange
+ } else {
+ $IWOK_WINDOWS($w,label) configure -text "Cannot write in directory $dest." -fg orange
+ }
+ return
+}
+proc wokDupEntryWhy { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set hli $IWOK_WINDOWS($w,hlist)
+ set item [$hli info anchor]
+ if { $item != {} } {
+ set data [$hli info data $item]
+ if { [set suspect [lindex $data 0]] } {
+ set flag [lindex $item 0]
+ set name [lindex $item 1]
+ set d1 [lindex $item 2]
+ if { "$flag" != "-" } {
+ if { [set lqueue [llength [set queue [lindex $data 1]]]] == 1 } {
+ tixBusy $w on
+ update
+ set report_path $d1/$name
+ set IWOK_WINDOWS($w,warfile) [set queue_path [lindex $queue 0]/$name]
+ set IWOK_WINDOWS($w,warunit) [lindex [split $item ^] 0]
+ wokDiffInText $IWOK_WINDOWS($w,text) $report_path $queue_path
+ set head [wokStore:Report:Head $queue_path]
+ set num [wokStore:Report:Index $IWOK_WINDOWS($w,qroot) $head]
+ set text "File $IWOK_WINDOWS($w,WBFils):$name < > File $name in Report $num"
+ $IWOK_WINDOWS($w,warbut) subwidget warget configure -state active -fg orange
+ $IWOK_WINDOWS($w,label) configure -text $text -fg orange
+ tixBusy $w off
+ if { [set xdiff [wokUtils:FILES:MoreDiff]] != {} } {
+ [$IWOK_WINDOWS($w,button) subwidget xdiff] configure -state active
+ eval "proc wokxdiff { args } {exec $xdiff $report_path $queue_path &}"
+ }
+ } else {
+ puts "plus d'une duplication: toplevel"
+ }
+ }
+ }
+
+ }
+ return
+}
+proc wokDupEntryShow { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set hli $IWOK_WINDOWS($w,hlist)
+ foreach U [$hli info children] {
+ foreach f [$hli info children $U] {
+ set data [$hli info data $f]
+ if { $IWOK_GLOBALS(CookHlist,dupl,show) == 0 } {
+
+ if { [lindex $data 0] == 0 } {
+ $hli hide entry $f
+ } else {
+ $hli show entry $f
+ }
+ } else {
+ $hli show entry $f
+ }
+ }
+ }
+ if { $IWOK_GLOBALS(CookHlist,dupl,show) == 1 } {
+ set IWOK_GLOBALS(CookHlist,dupl,show) 0
+ $IWOK_WINDOWS($w,warbut) subwidget warshow configure -text "Show warnings"
+ } else {
+ set IWOK_GLOBALS(CookHlist,dupl,show) 1
+ $IWOK_WINDOWS($w,warbut) subwidget warshow configure -text "Show all files"
+ }
+ return
+}
+
+proc wokDBGPrepare { {root {}} } {
+ set hli .woktopl:iwok.top.pane.list.list.f1.hlist
+ foreach c [$hli info children $root] {
+ puts "$c : data <[$hli info data $c]>"
+ wokDBGPrepare $c
+ }
+ return
+}
+
+
+proc wokRunPrepar { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ tixBusy $w on
+ update
+
+
+ set IWOK_GLOBALS(CookHlist) $IWOK_WINDOWS($w,hlist)
+
+ $IWOK_WINDOWS($w,hlist) delete all
+ $IWOK_WINDOWS($w,text) delete 0.0 end
+ $IWOK_WINDOWS($w,label) configure -text "" -fg yellow
+
+ foreach e [array names IWOK_GLOBALS CookHlist,dupl,*] {
+ catch { unset IWOK_GLOBALS($e) }
+ }
+
+ catch { unset tabqueue }
+ wokStore:Report:DumpQueue $IWOK_WINDOWS($w,qroot) tabqueue
+ if [array exists tabqueue] {
+ wokUtils:EASY:MAD IWOK_GLOBALS CookHlist,dupl,list tabqueue
+ }
+ set IWOK_GLOBALS(CookHlist,dupl,suspect) 0
+ set IWOK_GLOBALS(CookHlist,dupl,show) 0
+ set IWOK_GLOBALS(CookHlist,dupl,style) [tixDisplayStyle text -fg orange -font $IWOK_GLOBALS(boldfont)]
+ set IWOK_GLOBALS(CookHlist,dupl,ustyle) [tixDisplayStyle imagetext -font $IWOK_GLOBALS(boldfont)]
+
+ set IWOK_GLOBALS(comment,entered) 0
+ set IWOK_GLOBALS(comment,string) [wokIntegre:Journal:ReleaseNotes -1]
+
+ set lud {}
+ foreach item [$IWOK_WINDOWS($w,hlist2) info children] {
+ lappend lud [lindex $item 1]
+ }
+
+ set IWOK_GLOBALS(scratch) 0
+ if { $lud != {} } {
+ set ffils $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBFils)
+ set ffper $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBPere)
+ wokclose -a
+ if { "[w_info -A $ffils]" == "$IWOK_WINDOWS($w,WBFils)" } {
+ wokPrepare:Unit:Ref WOKCOOK $ffils [lsort $lud]
+ } else {
+ wokPrepare:Unit:Loop WOKCOOK $ffper $ffils [lsort $lud]
+ }
+ [$IWOK_WINDOWS($w,button) subwidget exclude] configure -state active
+ if { "$IWOK_WINDOWS($w,WBPere)" == "[lindex $IWOK_WINDOWS($w,LWB) 1]" } {
+ [$IWOK_WINDOWS($w,button) subwidget comment] configure -state active
+ } else {
+ [$IWOK_WINDOWS($w,button) subwidget comment] configure -state disabled
+ }
+ [$IWOK_WINDOWS($w,button) subwidget saveas] configure -state active
+ if $IWOK_GLOBALS(scratch) {
+ [$IWOK_WINDOWS($w,button) subwidget hide] configure -state active
+ [$IWOK_WINDOWS($w,button) subwidget rmeq] configure -state active
+ set IWOK_GLOBALS(scratch) 0
+ }
+ }
+ tixBusy $w off
+
+ if { $IWOK_GLOBALS(CookHlist,dupl,suspect) == 1 } {
+ $IWOK_WINDOWS($w,warbut) subwidget warshow configure -state active -fg orange
+ $IWOK_WINDOWS($w,label) configure -text \
+ "CAUTION: Some files in your report are already in the integration queue." -fg orange
+ }
+
+ return
+}
+;#
+;# Retire l'item designe de la Hlist
+;#
+proc wokExcludeItem { w } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ set entry [lindex [$hli info selection] 0]
+ if { $entry != "" } {
+ $hli delete entry $entry
+ }
+ return
+}
+;#
+;# retire les = dans la hlist de wprepare
+;#
+proc wokHideEq { w } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ foreach U [$hli info children] {
+ foreach f [$hli info children $U] {
+ set e [lindex [split $f ^] 1]
+ set flag [lindex [split $e] 0]
+ if { [string compare $flag =] == 0} {
+ $hli delete entry $U^$e
+ }
+ }
+ }
+ foreach U [$hli info children] {
+ if { [llength [$hli info children $U] ] == 0 } {
+ $hli delete entry $U
+ }
+ }
+ return
+}
+;#
+;# detruit les fichiers marques = dans la hlist de wprepare
+;#
+proc wokrmEq { w } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ set lrm {}
+ foreach U [$hli info children] {
+ foreach f [$hli info children $U] {
+ set l [split [lindex [split $f ^] 1]]
+ if { [string compare [lindex $l 0] =] == 0} {
+ lappend lrm "rm [lindex $l 2]/[lindex $l 1]"
+ }
+ }
+ }
+ set but [wokDangerDialBox .wokrmeq {Remove same files} {Really do that ?} $lrm danger 0 {Apply} {Cancel}]
+ if { $but == 0 } {
+ foreach f $lrm {
+ unlink [lindex $f 1]
+ $IWOK_WINDOWS($w,text) insert end "File [lindex $f 1] has been removed.\n"
+ }
+ wokHideEq $w
+ }
+ return
+}
+;#
+;#;+ xxx.tcl /adv_23/WOK/k1dev/subiwok/prod/WOKTclLib/src
+;# met a jour le workbench pere avec le contenu du report. Pas de store
+;#;# Mkf.tcl /adv_23/WOK/k1dev/subiwok/prod/WOKTclLib/src
+;#
+proc wokUpdateThat { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+
+ $IWOK_WINDOWS($w,text) delete 0.0 end
+ msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text)
+ set hli $IWOK_WINDOWS($w,hlist)
+ set lpere [w_info -l $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBPere)]
+ foreach U [$hli info children] {
+ if { [lsearch $lpere $U] == -1 } {
+ set T $IWOK_GLOBALS(L_S,[uinfo -t $U])
+ catch { ucreate -${T} $IWOK_WINDOWS($w,WBPere):$U }
+ }
+ set dest [wokinfo -p source:. $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBPere):$U]
+ if { [file exist $dest] && [file writable $dest] } {
+ foreach f [$hli info children $U] {
+ set e [lindex [split $f ^] 1]
+ if { "[lindex $e 0]" == "#" || "[lindex $e 0]" == "+" } {
+ set from [lindex $e 2]/[lindex $e 1]
+ set to $dest/[lindex $e 1]
+ if { [file exists $to] } {
+ if { [file writable $to] } {
+ msgprint -c WOKVC -i "Saving file $to in ${to}-sav"
+ wokUtils:FILES:copy $to ${to}-sav
+ msgprint -c WOKVC -i "Copying $from to $to"
+ wokUtils:FILES:copy $from $to
+ } else {
+ msgprint -c WOKVC -e "File $to cannot be overwritten"
+ }
+ } else {
+ msgprint -c WOKVC -i "Copying $from to $to"
+ wokUtils:FILES:copy $from $to
+ }
+ }
+ }
+ }
+ }
+ msgunsetcmd
+ $IWOK_WINDOWS($w,label) configure -text "Workbench $IWOK_WINDOWS($w,WBPere) has been updated."
+ return
+}
+;#
+;# fait wstore avec comme report le contenu du texte
+;#
+proc wokStoreThat { args } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ global wokfileid
+ global env
+
+ set w [lindex $args 0]
+ set asfile [expr { ([lindex $args 1] != {}) ? 1 : 0 } ]
+
+ set rep $env(HOME)/$IWOK_WINDOWS($w,WBFils).[id user].report
+ set wokfileid [open $rep w]
+
+ wokPrepare:Report:Output banner $IWOK_WINDOWS($w,shop) $IWOK_WINDOWS($w,WBFils)
+
+ set suspect 0
+ tixBusy $w on
+ update
+ set hli $IWOK_WINDOWS($w,hlist)
+ set pfx $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBFils)
+ foreach U [$hli info children] {
+ set T [uinfo -t ${pfx}:$U]
+ wokPrepare:Report:Output uheader $U.$T
+ foreach f [$hli info children $U] {
+ if { [lindex [$hli info data $f] 0] } {
+ set suspect 1
+ }
+ set e [lindex [split $f ^] 1]
+ set fl [lindex $e 2]/[lindex $e 1]
+ set dat [fmtclock [file mtime $fl] "%d/%m/%y %R"]
+ eval wokPrepare:Report:Output files [linsert $e 1 $dat]
+ }
+ }
+
+ tixBusy $w off
+ catch { unset dummyvar }
+ if { $IWOK_GLOBALS(comment,entered) } {
+ puts $wokfileid [append dummyvar is \n [wokTextToString $IWOK_WINDOWS($w,text)] end\; \n]
+ } else {
+ puts $wokfileid [append dummyvar is \n $IWOK_GLOBALS(comment,string) end\; \n]
+ }
+
+ close $wokfileid
+ catch {unset wokfileid}
+
+ if { $asfile } {
+ $IWOK_WINDOWS($w,label) configure -text "File $rep has been created."
+ } else {
+ if { $suspect } {
+ set retval [wokDialBox .wokcd {Duplicate entries} \
+ "Storing this report will possibly erase entries in the integration queue." \
+ warning 1 {Store anyway} {Abort}]
+ if { $retval } {
+ $IWOK_WINDOWS($w,label) configure -text "Abort..."
+ return
+ }
+ }
+ tixBusy $w on
+ $IWOK_WINDOWS($w,text) delete 0.0 end
+ msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text)
+ if { $IWOK_WINDOWS($w,trig) != 0 } {
+ wstore -ws $IWOK_WINDOWS($w,shop) -trig $rep
+ } else {
+ catch { wstore -ws $IWOK_WINDOWS($w,shop) $rep }
+ }
+ msgunsetcmd
+ $IWOK_WINDOWS($w,label) configure -text "Report $rep has been stored."
+ tixBusy $w off
+ }
+
+ return
+}
+;#
+;# Bof ..
+;#
+proc wokSaveas { w } {
+ wokStoreThat $w asfile
+ return
+}
+;#
+;#
+;#
+proc wokEnterComment { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ wokReadString $IWOK_WINDOWS($w,text) $IWOK_GLOBALS(comment,string)
+ set IWOK_GLOBALS(comment,entered) 1
+ wokActiveStore $w active
+ return
+}
+;#
+;#
+;#
+proc wokActiveStore { w state } {
+ global IWOK_WINDOWS
+ set IWOK_WINDOWS($w,trig) 0
+ if [wokStore:Queue:Enabled $IWOK_WINDOWS($w,shop) $IWOK_WINDOWS($w,WBPere)] {
+ $IWOK_WINDOWS($w,store) configure -state $state -text "Store" \
+ -command [list wokStoreThat $w]
+ if { [info commands $IWOK_WINDOWS($w,actrig)] != {} } {
+ $IWOK_WINDOWS($w,actrig) configure -state $state
+ }
+ } else {
+ $IWOK_WINDOWS($w,store) configure \
+ -state $state -text "Update $IWOK_WINDOWS($w,WBPere)" \
+ -command [list wokUpdateThat $w]
+ }
+ return
+}
+
+
+proc wokPrepareCheck { w } {
+ global IWOK_WINDOWS
+ $IWOK_WINDOWS($w,hlist) delete all
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text)
+ tixBusy $w on
+ update
+ foreach item [$IWOK_WINDOWS($w,hlist2) info children] {
+ set ud $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBFils):[lindex $item 1]
+ wcheck [uinfo -plTsource $ud]
+ }
+ tixBusy $w off
+ msgunsetcmd
+ [$IWOK_WINDOWS($w,button) subwidget search] configure -state active
+ return
+}
+
+
+
+proc wokPrepareHelp { w } {
+ global IWOK_GLOBALS
+ global IWOK_WINDOWS
+ global env
+
+ set IWOK_WINDOWS($w,help) [set wh .wokPrepareHelp]
+ if {[info exist IWOK_GLOBALS(windows)]} {
+ if {[lsearch $IWOK_GLOBALS(windows) $wh ] == -1} {
+ lappend IWOK_GLOBALS(windows) $wh
+ }
+ }
+
+ set whelp [wokHelp $wh "About preparing a workbench"]
+ set texte [lindex $whelp 0] ; set label [lindex $whelp 1]
+ wokReadFile $texte $env(WOK_LIBRARY)/wokPrepareHelp.hlp
+ wokFAM $texte <.*> { $texte tag add big first last }
+ $texte tag configure big -background Bisque3 -foreground black -borderwidth 2 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised
+ update
+ $texte configure -state disabled
+ return
+}
--- /dev/null
+proc wokWaffQueue { {loc {}} } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+
+
+ if { $loc == {} } {
+ set verrue [wokCWD readnocell]
+ } else {
+ regexp {(.*):Queue} $loc all verrue
+ }
+
+ if ![wokinfo -x $verrue] {
+ wokDialBox .wokcd {Unknown location} "Location $verrue is unknown" {} -1 OK
+ return
+ }
+ set shop [wokinfo -s $verrue]
+
+ set w [wokTPL queue${verrue}]
+ if [winfo exists $w ] {
+ wm deiconify $w
+ raise $w
+ return
+ }
+
+ toplevel $w
+ wm title $w "Integration Queue of $shop"
+ wm geometry $w 742x970+515+2
+
+ wokButton setw [list reports $w]
+
+ menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0
+ menu $w.file.m
+ $w.file.m add command -label "Close " -underline 1 -command [list wokWaffQueueExit $w]
+
+ menubutton $w.help -menu $w.help.m -text Help -underline 0 -takefocus 0
+ menu $w.help.m
+ $w.help.m add command -label "Help" -underline 1 -command [list wokWaffQueueHelp $w]
+
+ frame $w.top -relief sunken -bd 1
+ label $w.lab -relief raised
+
+ tixPanedWindow $w.top.pane -orient vertical -paneborderwidth 0 -separatorbg gray50
+ pack $w.top.pane -side top -expand yes -fill both -padx 10 -pady 10
+
+ set p1 [$w.top.pane add list -min 70 -size 200]
+ set p2 [$w.top.pane add text -min 70]
+
+ tixScrolledHList $p1.list ; set hlist [$p1.list subwidget hlist]
+ tixScrolledText $p2.text ; $p2.text subwidget text config -font $IWOK_GLOBALS(font)
+
+ $hlist config -font $IWOK_GLOBALS(font) -separator ^ -drawbranch 0 \
+ -browsecmd [list wokDisplayReport $w] ;#-selectmode single
+
+ pack $p1.list -expand yes -fill both -padx 1 -pady 1
+ pack $p2.text -expand yes -fill both -padx 1 -pady 1
+
+ tixLabelFrame $w.reports -label "Reports queue"
+ set fw [$w.reports subwidget frame]
+
+ tixButtonBox $fw.but -orientation horizontal -relief flat -padx 0 -pady 0
+ pack $fw.but -fill both
+
+ set buttons1 [list \
+ {integrate "Integrate" disabled wokIntegrateReport} \
+ {remove "Remove" disabled wokRemoveReport} \
+ {search "Search" disabled wokSearchReport} \
+ {updatequeue "Update" active wokUpdateQueue} ]
+
+ foreach b $buttons1 {
+ $fw.but add [lindex $b 0] -text [lindex $b 1]
+ [$fw.but subwidget [lindex $b 0]] configure -state [lindex $b 2] -command [list [lindex $b 3] $w]
+ }
+
+ tixLabelFrame $w.journal -label "Integration jounal"
+ set gw [$w.journal subwidget frame]
+
+ tixButtonBox $gw.but -orientation horizontal -relief flat -padx 0 -pady 0
+ pack $gw.but -fill both
+
+ set buttons1 [list \
+ {journal "Display" active wokReadStuffJournalOfshop} \
+ {today "Today's" active wokToday} \
+ {upday "Prev" active wokUpday} \
+ {downday "Next" active wokDownday} \
+ {toEditor "To Editor" active wokEditJnl} \
+ {search "Search" active wokSearchJnl} \
+ {purge "Purge" active wokPurgeJnl} ]
+
+ foreach b $buttons1 {
+ $gw.but add [lindex $b 0] -text [lindex $b 1]
+ [$gw.but subwidget [lindex $b 0]] configure -state [lindex $b 2] -command [list [lindex $b 3] $w]
+ }
+
+ tixForm $w.file ; tixForm $w.help -right -2
+ tixForm $w.reports -top $w.file -left 2 -right %40
+ tixForm $w.journal -top $w.file -left $w.reports -right -2
+ tixForm $w.top -top $w.reports -left 2 -right %99 -bottom $w.lab
+ tixForm $w.lab -left 2 -right %99 -bottom %99
+
+ set IWOK_WINDOWS($w,menu) $w.file.m
+ set IWOK_WINDOWS($w,label) $w.lab
+ set IWOK_WINDOWS($w,hlist) $hlist
+ set IWOK_WINDOWS($w,text) [$p2.text subwidget text]
+ set IWOK_WINDOWS($w,reports) $fw.but
+ set IWOK_WINDOWS($w,journal) $gw.but
+ set IWOK_WINDOWS($w,journal,day) [clock scan "00:00:00"]
+ set IWOK_WINDOWS($w,shop) $shop
+ set IWOK_WINDOWS($w,frigo) [wokStore:Report:GetRootName $IWOK_WINDOWS($w,shop)]
+ set IWOK_WINDOWS($w,basewrite) [wokIntegre:BASE:Writable $IWOK_WINDOWS($w,shop)]
+
+ wokUpdateQueue $w
+ set jnl [wokIntegre:Journal:GetName $IWOK_WINDOWS($w,shop)]
+ if [file exist $jnl] {
+ $w.lab configure -text "Last integration: [fmtclock [file mtime $jnl]]"
+ }
+
+ ;#bind $w <Destroy> { if [winfo exists %W] { wokWaffQueueExit %W }}
+
+ return
+}
+
+proc wokSearchJnl { w } {
+ global IWOK_WINDOWS
+ wokSEA $IWOK_WINDOWS($w,text)
+ return
+}
+
+proc wokReadStuffJournalOfshop { w } {
+ global IWOK_WINDOWS
+ tixBusy $w on
+ update
+ set jnltmp [wokUtils:FILES:tmpname jnltmp[id process].[wokinfo -n $IWOK_WINDOWS($w,shop)]]
+ if [file exists $jnltmp] {
+ unlink $jnltmp
+ }
+ wokIntegre:Journal:Assemble $jnltmp $IWOK_WINDOWS($w,shop)
+ if [file exists $jnltmp] {
+ wokReadFile $IWOK_WINDOWS($w,text) $jnltmp end
+ }
+ tixBusy $w off
+ $w.lab configure -text "Contents of integration journal"
+ return
+}
+;#
+;# Lecture du journal dans un editeur
+;#
+proc wokEditJnl { w } {
+ global IWOK_WINDOWS
+ tixBusy $w on
+ update
+ set jnltmp [wokUtils:FILES:tmpname jnltmp[id process].[wokinfo -n $IWOK_WINDOWS($w,shop)]]
+ if [file exists $jnltmp] {
+ unlink $jnltmp
+ }
+ wokIntegre:Journal:Assemble $jnltmp $IWOK_WINDOWS($w,shop)
+ if [file exists $jnltmp] {
+ wokEDF:EditFile $jnltmp
+ }
+ tixBusy $w off
+ return
+}
+;#
+;# Aujourd'hui
+;#
+proc wokToday { w } {
+ global IWOK_WINDOWS
+ set IWOK_WINDOWS($w,journal,day) [clock scan "00:00:00"]
+ wokThisday $w
+}
+;#
+;# Remonte d'un jour
+;#
+proc wokUpday { w } {
+ global IWOK_WINDOWS
+ incr IWOK_WINDOWS($w,journal,day) -[expr 24*3600]
+ wokThisday $w
+}
+;#
+;# Descend d'un jour
+;#
+proc wokDownday { w } {
+ global IWOK_WINDOWS
+ incr IWOK_WINDOWS($w,journal,day) [expr 24*3600]
+ wokThisday $w
+}
+;#
+;# affiche uniquement les integrations de la journee
+;#
+proc wokThisday { w } {
+ global IWOK_WINDOWS
+ tixBusy $w on
+ update
+ set jnltmp [wokUtils:FILES:tmpname jnltmp[id process].[wokinfo -n $IWOK_WINDOWS($w,shop)]]
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ if ![file exists $jnltmp] {
+ wokIntegre:Journal:Assemble $jnltmp $IWOK_WINDOWS($w,shop)
+ }
+ set upto [expr $IWOK_WINDOWS($w,journal,day) + 24*3600]
+ set str [wokIntegre:Journal:Since $jnltmp $IWOK_WINDOWS($w,journal,day) $upto]
+ if { $str != {} } {
+ wokReadString $IWOK_WINDOWS($w,text) $str
+ $w.lab configure -text "Done that day"
+ } else {
+ $w.lab configure -text "Nothing done that day"
+ }
+ tixBusy $w off
+ return
+}
+;#
+;# Procs appeles par quand on browse la liste des reports dans la queue
+;#
+proc wokDisplayReport { w jtem } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ if { $jtem != {} } {
+ tixBusy $w on
+ if { [string index $jtem 0] == "^" } {
+ set item [string range $jtem 1 end]
+ } else {
+ set item $jtem
+ }
+
+ set data [$hli info data $jtem]
+ switch -- $data {
+
+ Report {
+ catch { unset IWOK_WINDOWS($w,dupl,f1) }
+ catch { unset IWOK_WINDOWS($w,dupl,f2) }
+ catch { unset IWOK_WINDOWS($w,dupl,m1) }
+ catch { unset IWOK_WINDOWS($w,dupl,m2) }
+ set dir [wokStore:Report:GetTrueName $item $IWOK_WINDOWS($w,queue)]
+ wokReadFile $IWOK_WINDOWS($w,text) $IWOK_WINDOWS($w,frigo)/$dir/report-orig
+ $IWOK_WINDOWS($w,label) configure -text "Contents of report $item" -fg yellow
+ [$IWOK_WINDOWS($w,reports) subwidget remove] configure -state active
+ [$IWOK_WINDOWS($w,reports) subwidget search] configure -state active
+ if { $IWOK_WINDOWS($w,basewrite) } {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state active
+ } else {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state disabled
+ }
+ }
+
+ Doublon {
+ set indx [lindex [split $item ^] 0]
+ set path [lindex [split $item ^] 1]
+ if ![info exists IWOK_WINDOWS($w,dupl,f1)] {
+ set IWOK_WINDOWS($w,dupl,f1) $path
+ set IWOK_WINDOWS($w,dupl,m1) "Diff Report $indx : [file tail $path] < "
+ $IWOK_WINDOWS($w,label) configure -text $IWOK_WINDOWS($w,dupl,m1) -fg orange
+ } else {
+ if ![info exists IWOK_WINDOWS($w,dupl,f2)] {
+ set IWOK_WINDOWS($w,dupl,f2) $path
+ set IWOK_WINDOWS($w,dupl,m2) " > Report $indx : [file tail $path]"
+ wokDiffInText $IWOK_WINDOWS($w,text) \
+ $IWOK_WINDOWS($w,dupl,f1) $IWOK_WINDOWS($w,dupl,f2)
+ $IWOK_WINDOWS($w,label) configure -text \
+ "$IWOK_WINDOWS($w,dupl,m1) $IWOK_WINDOWS($w,dupl,m2)" -fg orange
+ catch { unset IWOK_WINDOWS($w,dupl,f1) }
+ catch { unset IWOK_WINDOWS($w,dupl,f2) }
+ catch { unset IWOK_WINDOWS($w,dupl,m1) }
+ catch { unset IWOK_WINDOWS($w,dupl,m2) }
+ }
+ }
+ [$IWOK_WINDOWS($w,reports) subwidget remove] configure -state disabled
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state disabled
+ }
+ }
+ tixBusy $w off
+ update
+ }
+ return
+}
+
+proc wokSearchReport { w } {
+ global IWOK_WINDOWS
+ wokSEA $IWOK_WINDOWS($w,text)
+ return
+}
+
+
+proc wokIntegrateReport { w } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ set anchor [$hli info anchor]
+ if { $anchor != {} } {
+ if { [string index $anchor 0] == "^" } {
+ set entry [string range $anchor 1 end]
+ } else {
+ set entry $anchor
+ }
+ set type [$hli info data $anchor]
+ if { "$type" == "Report" } {
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ msgsetcmd wokIntegre:Msg $w
+ tixBusy $w on
+ wintegre -ws $IWOK_WINDOWS($w,shop) $entry
+ msgunsetcmd
+ $IWOK_WINDOWS($w,text) see end
+ wokUpdateQueue $w
+ tixBusy $w off
+ }
+ }
+ return
+}
+
+proc wokRemoveReport { w } {
+ global IWOK_WINDOWS
+ set hli $IWOK_WINDOWS($w,hlist)
+ set anchor [$hli info anchor]
+ if { $anchor != {} } {
+ if { [string index $anchor 0] == "^" } {
+ set entry [string range $anchor 1 end]
+ } else {
+ set entry $anchor
+ }
+ set type [$hli info data $anchor]
+ if { "$type" == "Report" } {
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ msgsetcmd wokIntegre:Msg $w
+ tixBusy $w on
+ update
+ wstore -f -ws $IWOK_WINDOWS($w,shop) -rm $entry
+ msgunsetcmd
+ $IWOK_WINDOWS($w,text) see end
+ wokUpdateQueue $w
+ tixBusy $w off
+ }
+ }
+ return
+}
+
+proc wokIntegre:Msg { code msg args} {
+ global IWOK_WINDOWS
+ set w [lindex $args 0]
+ $IWOK_WINDOWS($w,text) insert end $msg\n
+ $IWOK_WINDOWS($w,text) see end
+ update
+ return
+}
+#
+# Met a jour la liste des reports dans la hlist d'adresse w
+#
+proc wokUpdateQueue { w } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set boldstyle [tixDisplayStyle text -font $IWOK_GLOBALS(boldfont)]
+ set dupstyle [tixDisplayStyle text -fg orange -font $IWOK_GLOBALS(boldfont)]
+ set hli $IWOK_WINDOWS($w,hlist)
+ set IWOK_WINDOWS($w,queue) [wokStore:Report:GetReportList $IWOK_WINDOWS($w,frigo)]
+ catch { unset IWOK_WINDOWS($w,dupl,f1) }
+ catch { unset IWOK_WINDOWS($w,dupl,f2) }
+ $hli delete all
+ $hli add ^
+ set i 0
+ catch { unset tabdup }
+ wokStore:Report:InitState $IWOK_WINDOWS($w,frigo) tabdup
+ if { [llength $IWOK_WINDOWS($w,queue)] != 0 } {
+ foreach e $IWOK_WINDOWS($w,queue) {
+ set user [wokUtils:FILES:Userid $IWOK_WINDOWS($w,frigo)/$e]
+ set str [wokStore:Report:GetPrettyName $e]
+ if { $str != {} } {
+ set rep [string range [lindex $str 0] 0 19]
+ set dte [lindex $str 1]
+ set affrep [format "%3d - %-10s %-20s (stored at %s)" [incr i] $user $rep $dte]
+ $hli add ^$i -text $affrep -itemtype text -style $boldstyle -data Report
+ if [info exists tabdup($e)] {
+ catch {unset dupfmt }
+ wokStore:Report:Fmtdup $IWOK_WINDOWS($w,frigo)/$e $tabdup($e) dupfmt
+ foreach u [lsort [array names dupfmt]] {
+ set udn [lindex [split $u .] 0]
+ foreach f $dupfmt($u) {
+ set text " ${udn}:${f}"
+ $hli add ^${i}^$IWOK_WINDOWS($w,frigo)/$e/${u}/${f} \
+ -text $text -data Doublon -itemtype text -style $dupstyle
+ }
+ }
+ }
+ }
+ }
+ if { $IWOK_WINDOWS($w,basewrite) } {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state active
+ } else {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state disabled
+ }
+ $IWOK_WINDOWS($w,reports) subwidget remove configure -state active
+ $IWOK_WINDOWS($w,reports) subwidget search configure -state active
+ } else {
+ if { $IWOK_WINDOWS($w,basewrite) } {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state disabled
+ } else {
+ [$IWOK_WINDOWS($w,reports) subwidget integrate] configure -state disabled
+ }
+ $IWOK_WINDOWS($w,reports) subwidget remove configure -state disabled
+ $IWOK_WINDOWS($w,reports) subwidget search configure -state disabled
+ }
+
+ update
+ return
+}
+
+proc wokWaffQueueExit { w } {
+ global IWOK_WINDOWS
+ destroy $w
+ foreach f [glob -nocomplain /tmp/jnltmp[id process].*] {
+ catch { unlink $f }
+ }
+ if [info exists IWOK_WINDOWS($w,help)] {
+ catch {destroy $IWOK_WINDOWS($w,help)}
+ }
+ wokButton delw [list reports $w]
+ return
+}
+
+proc wokShowTrig { w trigcmd } {
+ global IWOK_WINDOWS
+ wokReadFile $IWOK_WINDOWS($w,text) $trigcmd
+ return
+}
+
+proc wokPurgeJnl { w } {
+ global IWOK_WINDOWS
+ msgsetcmd wokIntegre:Msg $w
+ tixBusy $w on
+ wokIntegre:Journal:Purge $IWOK_WINDOWS($w,shop)
+ tixBusy $w off
+ msgunsetcmd
+ return
+}
+
+proc wokWaffQueueHelp { w } {
+ global IWOK_GLOBALS
+ global IWOK_WINDOWS
+ global env
+
+ set IWOK_WINDOWS($w,help) [set wh .wokWaffQueueHelp]
+ if {[info exist IWOK_GLOBALS(windows)]} {
+ if {[lsearch $IWOK_GLOBALS(windows) $wh ] == -1} {
+ lappend IWOK_GLOBALS(windows) $wh
+ }
+ }
+
+ set whelp [wokHelp $wh "About integration queue"]
+ set texte [lindex $whelp 0] ; set label [lindex $whelp 1]
+ wokReadFile $texte $env(WOK_LIBRARY)/wokWaffQueueHelp.hlp
+ wokFAM $texte <.*> { $texte tag add big first last }
+ $texte tag configure big -background Bisque3 -foreground black -borderwidth 2 \
+ -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised
+ update
+ $texte configure -state disabled
+ return
+}
--- /dev/null
+#
+#
+#
+proc wokHliAdd { item w } {
+ global IWOK_WINDOWS
+ set hli1 $IWOK_WINDOWS($w,hlist1)
+ set hli2 $IWOK_WINDOWS($w,hlist2)
+ if {$item != ""} {
+ if {[$hli2 info exist $item] == 0} {
+ $hli2 add $item -itemtype imagetext -text [lindex $item 1] \
+ -image [tix getimage [lindex $item 0]]
+ $hli1 entryconfigure $item -image [tix getimage [lindex $item 0]_open]
+ }
+ }
+ return
+}
+
+proc wokHliDel { item w } {
+ global IWOK_WINDOWS
+ $IWOK_WINDOWS($w,hlist2) delete entry $item
+ if [$IWOK_WINDOWS($w,hlist1) info exist $item] {
+ $IWOK_WINDOWS($w,hlist1) entryconfigure $item -image [tix getimage [lindex $item 0]]
+ }
+ return
+}
+
+proc wokHliAddall { w } {
+ global IWOK_WINDOWS
+ set hli1 $IWOK_WINDOWS($w,hlist1)
+ set hli2 $IWOK_WINDOWS($w,hlist2)
+ foreach item [$hli1 info children] {
+ if {[$hli2 info exist $item] == 0} {
+ $hli2 add $item -itemtype imagetext -text [lindex $item 1] \
+ -image [tix getimage [lindex $item 0]]
+ $hli1 entryconfigure $item -image [tix getimage [lindex $item 0]_open]
+ }
+ }
+ return
+}
+
+proc wokHliDelall { w } {
+ global IWOK_WINDOWS
+ foreach item [$IWOK_WINDOWS($w,hlist2) info children] {
+ $IWOK_WINDOWS($w,hlist2) delete entry $item
+ if [$IWOK_WINDOWS($w,hlist1) info exist $item] {
+ $IWOK_WINDOWS($w,hlist1) entryconfigure $item -image [tix getimage [lindex $item 0]]
+ }
+ }
+
+ if [info exists $IWOK_WINDOWS($w,text) ] {
+ $IWOK_WINDOWS($w,text) delete 0.0 end
+ }
+ if [info exists $IWOK_WINDOWS($w,label) ] {
+ $IWOK_WINDOWS($w,label) configure -text ""
+ }
+ return
+}
+;#
+;# cree un toplevel de nom w de tit appelle function en lui
+;# passant w le path du toplevel cree.
+;# Si il existe deja, le pop
+;#
+proc wokTL { w t size {func nop} } {
+ global IWOK_GLOBALS
+ if [winfo exists $w] {
+ wm deiconify $w
+ raise $w
+ } else {
+ if {[info exist IWOK_GLOBALS(windows)]} {
+ if {[lsearch $IWOK_GLOBALS(windows) $w] == -1} {
+ lappend IWOK_GLOBALS(windows) $w
+ }
+ }
+ toplevel $w
+ wm title $w $t
+ if { $size != {} } {
+ wm geometry $w $size
+ }
+ if {[string compare $func nop] != 0} {
+ $func $w
+ }
+ }
+ return
+}
+;#
+;# retourne la taille du toplevel en fonction de type
+;#
+proc wokTLAdjust { stuff } {
+ global IWOK_GLOBALS
+ if { [string compare $stuff source] == 0 } {
+ return $IWOK_GLOBALS(windows,barr)
+ } else {
+ return $IWOK_GLOBALS(windows,rect)
+ }
+}
+#
+# Retourne la liste contenant chaque ligne (\) du texte comme element
+#
+proc wokTextToList {text} {
+ return [split [$text get 1.0 end] \n]
+}
+#
+# Ecrit le texte dans path
+#
+proc wokTextToFile {text file} {
+ wokUtils:FILES:ListToFile [wokTextToList $text] $file
+ return
+}
+#
+# Retourne la string contenant le texte
+#
+proc wokTextToString {text} {
+ return [$text get 1.0 end]
+}
+#
+# Met le fichier dans un texte
+#
+proc wokReadFile {text filename {ext 1.0} } {
+ $text delete 0.0 end
+ catch {
+ set fd [open $filename {RDONLY}]
+ $text delete 1.0 end
+
+ while {![eof $fd]} {
+ $text insert end [gets $fd]\n
+ }
+ close $fd
+
+ }
+ $text see $ext
+ update idletasks
+ return
+}
+#
+# Met la liste dans un texte
+#
+proc wokReadList {text liste} {
+ $text delete 0.0 end
+ foreach string $liste {
+ $text insert end $string\n
+ }
+ $text see 1.0
+ update idletasks
+ return
+}
+#
+# Met la string dans un texte
+#
+proc wokReadString {text string} {
+ $text delete 0.0 end
+ $text insert end $string\n
+ $text see 1.0
+ update idletasks
+ return
+}
+#
+# met ar dans texte
+#
+proc wokArInText {text file} {
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ wokReadString $text [exec ar tv $file]
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ }
+ return
+}
+;#
+;# insere le contenu d'un fichier dans texte. Si il y un label, le configure
+;#
+proc wokDisplayFileinText { item w } {
+ global IWOK_WINDOWS
+ wokReadFile $IWOK_WINDOWS($w,text) $item
+ if [info exists $IWOK_WINDOWS($w,label)] {
+ $IWOK_WINDOWS($w,label) configure -text "File $item"
+ }
+ return
+}
+;#
+;# Utilisee par wokCreations et wokDeletion et wokStore
+;#
+proc wokMessageInText { code msg text} {
+ $text insert end $msg\n
+ $text see end
+ update
+ return
+}
+;#
+;# Met un diff dans un text
+;#
+proc wokDiffInText { text f1 f2 } {
+ global tcl_platform
+ set wtmp [wokUtils:FILES:tmpname wokdiff[pid]]
+ if { "$tcl_platform(platform)" == "unix" } {
+ catch {exec diff $f1 $f2 > $wtmp}
+ wokReadFile $text $wtmp
+ unlink $wtmp
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ $text delete 0.0 end
+ $text insert end {Click on button "More diff" instead.}
+ update
+ }
+ return
+}
+;#
+;#
+;#
+proc wokDangerDialBox { w title conftext items bitmap default args } {
+ global button
+ toplevel $w -class Dialog
+ wm title $w $title
+ wm iconname $w Dialog
+ wm geometry $w 453x314
+ frame $w.top -relief raised -bd 1
+ pack $w.top -side top -fill both
+ frame $w.bot -relief raised -bd 1
+ pack $w.bot -side bottom -fill both
+ label $w.top.lab
+ set img [image create compound -window $w.top.lab]
+ $img add space -width 10
+ $img add image -image [tix getimage $bitmap]
+ $img add space -width 10
+ $img add text -text $conftext
+ $w.top.lab config -image $img
+ pack $w.top.lab -expand 1 -fill both
+ tixScrolledListBox $w.top.msg
+ foreach e $items {
+ [$w.top.msg subwidget listbox] insert end $e
+ }
+ $w.top.msg configure -state disabled
+ pack $w.top.msg -side right -expand 1 -fill both -padx 3m -pady 3m
+ set i 0
+ foreach but $args {
+ button $w.bot.button$i -text $but -command\
+ "set button $i"
+ if {$i == $default } {
+ frame $w.bot.default -relief sunken -bd 1
+ raise $w.bot.button$i
+ pack $w.bot.default -side left -expand 1\
+ -padx 3m -pady 2m
+ pack $w.bot.button$i -in $w.bot.default\
+ -side left -padx 2m -pady 2m\
+ -ipadx 2m -ipady 1m
+ } else {
+ pack $w.bot.button$i -side left -expand 1\
+ -padx 3m -pady 3m -ipadx 2m -ipady 1m
+ }
+ incr i
+ }
+ if {$default >= 0 } {
+ bind $w <Return> "$w.bot.button$default flash;set button $default"
+ }
+ set oldFocus [focus]
+ grab set $w
+ focus $w
+ tkwait variable button
+ destroy $w
+ focus $oldFocus
+ return $button
+}
+
+
+proc wokDialBox { w title text bitmap default args } {
+ global button
+ toplevel $w -class Dialog
+ wm title $w $title
+ wm iconname $w Dialog
+ frame $w.top -relief raised -bd 1
+ pack $w.top -side top -fill both
+ frame $w.bot -relief raised -bd 1
+ pack $w.bot -side bottom -fill both
+ message $w.top.msg -width 4i -text $text
+ pack $w.top.msg -side right -expand 1 -fill both -padx 3m -pady 3m
+ if {$bitmap != "" } {
+ label $w.top.bitmap -bitmap $bitmap
+ pack $w.top.bitmap -side left -padx 3m -pady 3m
+ }
+ set i 0
+ foreach but $args {
+ button $w.bot.button$i -text $but -command\
+ "set button $i"
+ if {$i == $default } {
+ frame $w.bot.default -relief sunken -bd 1
+ raise $w.bot.button$i
+ pack $w.bot.default -side left -expand 1\
+ -padx 3m -pady 2m
+ pack $w.bot.button$i -in $w.bot.default\
+ -side left -padx 2m -pady 2m\
+ -ipadx 2m -ipady 1m
+ } else {
+ pack $w.bot.button$i -side left -expand 1\
+ -padx 3m -pady 3m -ipadx 2m -ipady 1m
+ }
+ incr i
+ }
+ if {$default >= 0 } {
+ bind $w <Return> "$w.bot.button$default flash;set button $default"
+ }
+ set oldFocus [focus]
+ grab set $w
+ focus $w
+ tkwait variable button
+ destroy $w
+ focus $oldFocus
+ return $button
+}
+
+;#
+;# applique script sur tous les <patterns> du text w
+;#
+proc wokFAM { w pattern script } {
+ scan [$w index end] %d numlines
+ for {set i 1} {$i < $numlines} {incr i} {
+ $w mark set last $i.0
+ while { [regexp -indices $pattern \
+ [$w get last "last lineend"] indices]} {
+ $w mark set first \
+ "last + [lindex $indices 0] chars"
+ $w mark set last "last + 1 chars\
+ + [lindex $indices 1] chars"
+ uplevel $script
+ }
+ }
+}
+
+proc wokWait {command w args} {
+ tixBusy $w on
+ set id [after 10000 tixBusy $w off]
+ eval $command $args
+ after cancel $id
+ after 0 tixBusy $w off
+ return
+}
+
+;#
+;# Toplevel d'un help (Simple texte + label)
+;# retourne une liste de 2 elements le texte et le label
+;#
+proc wokHelp { w title {geometry 950x450} } {
+
+ catch { destroy $w } ; toplevel $w ; wm title $w $title ; wm geometry $w $geometry
+
+ set fnt [tix option get fixed_font]
+
+ menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0
+ menu $w.file.m ; $w.file.m add command -label "Close " -underline 1 -command "destroy $w"
+
+ frame $w.top -relief sunken -bd 1
+ label $w.lab -relief raised
+
+ tixScrolledText $w.text ; set texte [$w.text subwidget text] ; $texte config -font $fnt
+
+ tixForm $w.file
+ tixForm $w.top -top $w.file -left 2 -right %99
+ tixForm $w.text -left 2 -top $w.top -bottom $w.lab -right %99
+ tixForm $w.lab -left 2 -right %99 -bottom %99
+
+ return [list $texte $w.lab]
+
+}
--- /dev/null
+;;; woksh.el --- WOK TCL interface
+
+;;; Code:
+
+(require 'comint)
+(require 'shell)
+(require 'wok-comm)
+
+;;(defvar woksh-program "tclsh"
+(defvar woksh-program "D:/DevTools/TclTk/bin/ntsh.exe"\r
+ "*Name of program to invoke woksh")
+
+(defvar woksh-explicit-args nil
+ "*List of arguments to pass to woksh on the command line.")
+
+(defvar woksh-mode-hook nil
+ "*Hooks to run after setting current buffer to woksh-mode.")
+
+(defvar woksh-process-connection-type t
+ "*If non-`nil', use a pty for the local woksh process.
+If `nil', use a pipe (if pipes are supported on the local system).
+
+Generally it is better not to waste ptys on systems which have a static
+number of them. On the other hand, some implementations of `woksh' assume
+a pty is being used, and errors will result from using a pipe instead.")
+
+(defvar woksh-directory-tracking-mode 'local
+ "*Control whether and how to do directory tracking in an woksh buffer.
+
+nil means don't do directory tracking.
+
+t means do so using an ftp remote file name.
+
+Any other value means do directory tracking using local file names.
+This works only if the remote machine and the local one
+share the same directories (through NFS). This is the default.
+
+This variable becomes local to a buffer when set in any fashion for it.
+
+It is better to use the function of the same name to change the behavior of
+directory tracking in an woksh session once it has begun, rather than
+simply setting this variable, since the function does the necessary
+re-synching of directories.")
+
+(make-variable-buffer-local 'woksh-directory-tracking-mode)
+
+;; Initialize woksh mode map.
+(defvar woksh-mode-map '())
+(cond
+ ((null woksh-mode-map)
+ (setq woksh-mode-map (if (consp shell-mode-map)
+ (cons 'keymap shell-mode-map)
+ (copy-keymap shell-mode-map)))
+ (define-key woksh-mode-map "\C-c\C-c" 'woksh-send-Ctrl-C)
+ (define-key woksh-mode-map "\C-c\C-d" 'woksh-send-Ctrl-D)
+ (define-key woksh-mode-map "\C-c\C-z" 'woksh-send-Ctrl-Z)
+ (define-key woksh-mode-map "\C-c\C-\\" 'woksh-send-Ctrl-backslash)
+ (define-key woksh-mode-map "\C-d" 'woksh-delchar-or-send-Ctrl-D)
+ (define-key woksh-mode-map "\C-i" 'woksh-tab-or-complete)))
+
+\f
+;;(add-hook 'same-window-regexps "^\\*woksh-.*\\*\\(\\|<[0-9]+>\\)")
+
+(defvar woksh-history nil)
+
+;;;###autoload
+(defun woksh (input-args &optional buffer)
+ "Open a woksh"
+
+ (interactive (list
+ "1566"
+ current-prefix-arg))
+
+ (let* ((process-connection-type woksh-process-connection-type)
+ (args nil)
+ (buffer-name "*woksh*")
+ (iport (string-to-int input-args))
+ proc)
+
+ (cond ((null buffer))
+ ((stringp buffer)
+ (setq buffer-name buffer))
+ ((bufferp buffer)
+ (setq buffer-name (buffer-name buffer)))
+ ((numberp buffer)
+ (setq buffer-name (format "%s<%d>" buffer-name buffer)))
+ (t
+ (setq buffer-name (generate-new-buffer-name buffer-name))))
+
+ (setq buffer (get-buffer-create buffer-name))
+ (pop-to-buffer buffer-name)
+
+ (cond
+ ((comint-check-proc buffer-name))
+ (t
+ (comint-exec buffer buffer-name woksh-program nil args)
+ (setq proc (get-buffer-process buffer))
+ ;; Set process-mark to point-max in case there is text in the
+ ;; buffer from a previous exited process.
+ (set-marker (process-mark proc) (point-max))
+ (woksh-mode)
+
+ ;; comint-output-filter-functions is just like a hook, except that the
+ ;; functions in that list are passed arguments. add-hook serves well
+ ;; enough for modifying it.
+ (add-hook 'comint-output-filter-functions 'woksh-carriage-filter)
+
+ (cd-absolute (concat comint-file-name-prefix "~/"))))
+ (if (not (eq iport 0))
+ (if (not (wok-connectedp))
+ (progn
+ (send-string nil (format "wokemacs_init %d\n" iport))
+ (wok-connect-to-controller "localhost" iport)
+ (send-string nil "auto_load wok_cd_proc\n")
+ (erase-buffer)
+ )))))
+
+(defun woksh-mode ()
+ "Set major-mode for woksh sessions.
+If `woksh-mode-hook' is set, run it."
+ (interactive)
+ (kill-all-local-variables)
+ (shell-mode)
+ (setq major-mode 'woksh-mode)
+ (setq mode-name "woksh")
+ (use-local-map woksh-mode-map)
+ (setq shell-dirtrackp woksh-directory-tracking-mode)
+ (make-local-variable 'comint-file-name-prefix)
+ (run-hooks 'woksh-mode-hook))
+
+(defun woksh-directory-tracking-mode (&optional prefix)
+ "Do remote or local directory tracking, or disable entirely.
+
+If called with no prefix argument or a unspecified prefix argument (just
+``\\[universal-argument]'' with no number) do remote directory tracking via
+ange-ftp. If called as a function, give it no argument.
+
+If called with a negative prefix argument, disable directory tracking
+entirely.
+
+If called with a positive, numeric prefix argument, e.g.
+``\\[universal-argument] 1 M-x woksh-directory-tracking-mode\'',
+then do directory tracking but assume the remote filesystem is the same as
+the local system. This only works in general if the remote machine and the
+local one share the same directories (through NFS)."
+ (interactive "P")
+ (cond
+ ((or (null prefix)
+ (consp prefix))
+ (setq woksh-directory-tracking-mode t)
+ (setq shell-dirtrackp t)
+ (setq comint-file-name-prefix ""))
+ ((< prefix 0)
+ (setq woksh-directory-tracking-mode nil)
+ (setq shell-dirtrackp nil))
+ (t
+ (setq woksh-directory-tracking-mode 'local)
+ (setq comint-file-name-prefix "")
+ (setq shell-dirtrackp t)))
+ (cond
+ (shell-dirtrackp
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (proc-mark (process-mark proc))
+ (current-input (buffer-substring proc-mark (point-max)))
+ (orig-point (point))
+ (offset (and (>= orig-point proc-mark)
+ (- (point-max) orig-point))))
+ (unwind-protect
+ (progn
+ (delete-region proc-mark (point-max))
+ (goto-char (point-max))
+ (shell-resync-dirs))
+ (goto-char proc-mark)
+ (insert current-input)
+ (if offset
+ (goto-char (- (point-max) offset))
+ (goto-char orig-point)))))))
+
+\f
+;; Parse a line into its constituent parts (words separated by
+;; whitespace). Return a list of the words.
+(defun woksh-parse-words (line)
+ (let ((list nil)
+ (posn 0)
+ (match-data (match-data)))
+ (while (string-match "[^ \t\n]+" line posn)
+ (setq list (cons (substring line (match-beginning 0) (match-end 0))
+ list))
+ (setq posn (match-end 0)))
+ (store-match-data (match-data))
+ (nreverse list)))
+
+(defun woksh-carriage-filter (string)
+ (let* ((point-marker (point-marker))
+ (end (process-mark (get-buffer-process (current-buffer))))
+ (beg (or (and (boundp 'comint-last-output-start)
+ comint-last-output-start)
+ (- end (length string)))))
+ (goto-char beg)
+ (while (search-forward "\C-m" end t)
+ (delete-char -1))
+ (goto-char point-marker)))
+
+(defun woksh-send-Ctrl-C ()
+ (interactive)
+ (send-string nil "\C-c"))
+
+(defun woksh-send-Ctrl-D ()
+ (interactive)
+ (send-string nil "\C-d"))
+
+(defun woksh-send-Ctrl-Z ()
+ (interactive)
+ (send-string nil "\C-z"))
+
+(defun woksh-send-Ctrl-backslash ()
+ (interactive)
+ (send-string nil "\C-\\"))
+
+(defun woksh-delchar-or-send-Ctrl-D (arg)
+ "\
+Delete ARG characters forward, or send a C-d to process if at end of buffer."
+ (interactive "p")
+ (if (eobp)
+ (woksh-send-Ctrl-D)
+ (delete-char arg)))
+
+(defun woksh-tab-or-complete ()
+ "Complete file name if doing directory tracking, or just insert TAB."
+ (interactive)
+ (if woksh-directory-tracking-mode
+ (comint-dynamic-complete)
+ (insert "\C-i")))
+;;
+
+(defun wok-command (command)
+ (interactive (list (read-from-minibuffer "Command : "
+ nil nil nil 'woksh-history)))
+ (save-excursion
+
+ (if (not (wok-connectedp))
+ (if (equal "yes" (completing-read "WOK not connected: connect ? (yes/no) : "
+ '(("yes") ("no")) nil t
+ '("yes" . 0) 'woksh-history))
+ (woksh "1566" "*woksh*")
+ ))
+
+ (if (wok-connectedp)
+ (progn
+ (set-buffer "*woksh*")
+ (woksh-parse-words (wok-send-command command)))
+ (progn
+ (ding)
+ (error "Wok controller not connected")))))
+
+;; Goto Entity
+
+(defun wokcd ( userpath )
+ "\
+Moves into a Wok entity"
+ (interactive (list (read-from-minibuffer "wokcd : "
+ nil nil nil 'woksh-history)))
+
+ (wok-command (format "wokcd %s" userpath)))
+
+
+(defun wcd ( Unit )
+ (interactive (list (read-from-minibuffer "wcd : "
+ nil nil nil 'woksh-history)))
+ (wok-command (format "wokcd %s -PSrc" Unit)))
+
+;;; woksh.el ends here
+(defvar woksh-entity-history nil)
+(defvar woksh-type-history nil)
+(defvar woksh-name-history nil)
+
+(defun wok-dired ( Entity Type )
+ (interactive (list
+ (setq myent (completing-read "Entity : "
+ (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil
+ (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history))
+ (completing-read "Type : "
+ (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil
+ '("source" . 0) 'woksh-type-history)))
+ ;; insert formatted string into a buffer
+ (let ((type Type))
+ (if (not (string-match ":" Type))
+ (setq type (format "%s:." Type)))
+ (set-buffer (dired
+ (car (wok-command (format "wokinfo -p %s %s\n" type Entity)))))
+
+ (rename-buffer (format "%s-%s [%s] (%s)"
+ (car (wok-command (format "wokinfo -n %s" Entity)))
+ type
+ (car (wok-command (format "wokinfo -N %s" Entity)))
+ (car (wok-command (format "wokinfo -t %s" Entity)))))))
+
+(defun wok-findfile ( Entity Type FileName )
+ (interactive (list
+ (setq myent (completing-read "Entity : "
+ (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil
+ (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history))
+ (setq mytype (completing-read "Type : "
+ (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil
+ '("source" . 0) 'woksh-type-history))
+ (completing-read "Name : "
+ (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil
+ '("" . 0) 'woksh-name-history)))
+ ;; insert formatted string into a buffer
+ (set-buffer (find-file
+ (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName)))))
+ )
+
+(defun wok-locate ( Entity Type FileName )
+ (interactive (list
+ (setq myent (completing-read "Entity : "
+ (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil
+ (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history))
+ (setq mytype (completing-read "Type : "
+ (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil
+ '("source" . 0) 'woksh-type-history))
+ (completing-read "Name : "
+ (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil
+ '("" . 0) 'woksh-name-history)))
+ ;; insert formatted string into a buffer
+ (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName)))
+ )
+
+
+(setq wok-compile-defaults '('("umake") ("umake -o obj") ("umake -o exec") ("umake -o xcpp")))
+
+(defun wok-compile ( commande )
+ (interactive (list
+ (completing-read "Command : "
+ wok-compile-defaults nil nil
+ "umake " 'woksh-history)))
+ (set-buffer "*woksh*")
+ (wok-command commande))
+
+(defun concat-list-error (thelist)
+ (let ((res " "))
+ (mapcar (lambda (x)
+ (setq res (concat res x " ")))
+ thelist)
+ res))
+
+(defun receive-tcl-error (linearg)
+ (interactive)
+
+ (kill-buffer (switch-to-buffer-other-window "*compilation*"))
+ (switch-to-buffer-other-window "*compilation*")
+ (compilation-mode)
+ (goto-char (point-max))
+ (insert "\n\n")
+ (insert-file linearg)
+ (compile-goto-error)
+)
--- /dev/null
+
+#############################################################################
+#
+# W S T O R E
+# ___________
+#
+#############################################################################
+#
+# Usage
+#
+proc wokStoreUsage { } {
+ global env
+ puts stderr \
+ {
+ Usage : wstore [-f] [-rm|-ls|-cat] [-queue name] [filename]
+
+ wstore filename : Add a report in the report's list from <filename>.
+ wstore [-ls] : Lists pending reports with their owner and IDs.
+ wstore -cat <report_ID> : Shows the content of <report_ID>.
+ wstore [-f] -rm <report_ID>: Remove a report from the queue
+ : (-f used to force if you dont own the report).
+
+ Backup/Admin options:
+ -ctar <filename> : Create a tar file named <filename> with all reports in queue.
+ -xtar <filename> : Add all reports from tar file <filename>.
+ Add -v option to display informational messages
+
+ -dump <report_ID> : Dump contents of Report .
+ -param : Lists queue parameters associed with the concerned workshop.
+
+ To store a "wpack archive files":
+
+ wstore -ar Archname.Z (See command wpack)
+
+ -queue option allows you to specify a queue name.
+ To create a queue named XXX , define parameter VC_XXX (VC.edl) to a directory name.
+ The queue XXX will be created under this directory.
+
+ }
+ return
+}
+#
+# Point d'entree de la commande
+#
+proc wstore { args } {
+
+ set tblreq(-h) {}
+ set tblreq(-f) {}
+ set tblreq(-rm) {}
+ set tblreq(-ls) {}
+ set tblreq(-cat) {}
+ set tblreq(-trig) {}
+
+ set tblreq(-ctar) value_required:string
+ set tblreq(-xtar) value_required:string
+ set tblreq(-v) {}
+
+ set tblreq(-ar) value_required:string
+
+ set tblreq(-dump) {}
+ set tblreq(-param) {}
+
+ set tblreq(-ws) value_required:string
+
+ set tblreq(-queue) value_required:string
+
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param tabarg tblreq wokStoreUsage $args] == -1 } return
+
+ set option_specified [array exists tabarg]
+
+ if { [info exists tabarg(-h)] } {
+ wokStoreUsage
+ return
+ }
+
+ if { [info exists tabarg(-f)] } {
+ set forced -1
+ } else {
+ set forced 0
+ }
+
+ if [info exists tabarg(-ws)] {
+ set fshop $tabarg(-ws)
+ } else {
+ set fshop [wokinfo -s [wokcd]]
+ }
+ set lshop [finfo -s $fshop]
+ if { [lsearch $lshop [wokinfo -n [wokinfo -s $fshop]] ] == -1 } {
+ msgprint -c WOKVC -e "Invalid Shop name or no current shop. Should be one of $lshop."
+ return
+ }
+
+ if { [info exists tabarg(-param)] } {
+ wokStore:Report:GetType $fshop 1
+ return
+ }
+
+ if [info exists tabarg(-queue)] {
+ set inqueue $tabarg(-queue)
+ set FrigoName [wokStore:Report:GetQName $fshop $tabarg(-queue) 1]
+ } else {
+ set inqueue "default queue of $fshop"
+ set FrigoName [wokStore:Report:GetRootName $fshop 1]
+ }
+
+ if { $FrigoName == {} } {
+ msgprint -c WOKVC -e "Bad queue name. Check file [wokinfo -p AdmDir]/VC.edl"
+ return
+ }
+
+
+ if { [info exists tabarg(-ar)] } {
+ set Zadr $tabarg(-ar)
+ set adr [wokUtils:FILES:SansZ $Zadr]
+ if { $adr != -1} {
+ if ![catch {set idar [open $adr r]} status] {
+ set TID [file tail $adr]
+ set entry [wokStore:Report:GetUniqueName $TID]
+ if { $entry != {} } {
+ wokStore:Report:UnPack $idar $FrigoName/${entry}
+ close $idar
+ } else {
+ msgprint -c WOKVC -e "Report name should not contains a comma."
+ }
+ } else {
+ puts stderr "Error: $status"
+ }
+ if [file exists $adr] {
+ catch {unlink $adr}
+ }
+ }
+ return
+ }
+
+
+ set ListReport [wokStore: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
+ wokStore:Report:InitState $FrigoName tabdup
+ foreach e $ListReport {
+ set user [wokUtils:FILES:Userid $FrigoName/$e]
+ set str [wokStore: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 ]
+ if [info exists tabdup($e)] {
+ catch {unset dupfmt }
+ wokStore:Report:Fmtdup $FrigoName/$e $tabdup($e) dupfmt
+ foreach u [lsort [array names dupfmt]] {
+ puts " [lindex [split $u .] 0]:"
+ foreach f $dupfmt($u) {
+ puts " $f ($FrigoName/$e/${u}/${f})"
+ }
+ }
+ }
+ } else {
+ msgprint -c WOKVC -e "Bad entry ($e) found in report.list"
+ }
+ }
+ } else {
+ if [info exists tabarg(-ctar)] {
+ if { $ListReport != {} } {
+ set tarfile $tabarg(-ctar)
+ if { [file dirname $tarfile] == "." } {
+ set tarfile [pwd]/$tarfile
+ }
+ if [file writable [file dirname $tarfile]] {
+ return [wokStore:Queue:Tar $FrigoName $tarfile]
+ } else {
+ msgprint -c WOKVC -e "You cannot write in [file dirname $tarfile]"
+ return {}
+ }
+ } else {
+ msgprint -c WOKVC -e "Report Queue is empty."
+ return {}
+ }
+ }
+ if [info exists tabarg(-xtar)] {
+ set tarfile $tabarg(-xtar)
+ if { [file exists $tarfile] } {
+ wokStore:Queue:Untar $tarfile $FrigoName [info exists tabarg(-v)]
+ } else {
+ msgprint -c WOKVC -e "File $tarfile not found."
+ return {}
+ }
+ }
+ }
+ return
+ }
+
+ ;#
+ ;# Options s'appliquant a un ID
+ ;#
+
+ if ![wokUtils:FILES:ValidName $ID] {
+ msgprint -c WOKVC -e "Malformed command or invalid file name $ID"
+ return {}
+ }
+
+ wokPrepare:Report:InitTypes
+
+ if [info exists tabarg(-rm)] {
+ set entry [wokStore:Report:GetTrueName $ID $ListReport]
+ if { $entry != {} } {
+ wokStore:Report:Del $FrigoName/$entry $forced
+ }
+ return
+ }
+
+ if [info exists tabarg(-cat)] {
+ set entry [wokStore:Report:GetTrueName $ID $ListReport]
+ if { $entry != {} } {
+ set rep $FrigoName/$entry/report-orig
+ if { [file exists $rep] } {
+ return [exec cat $rep]
+ } else {
+ msgprint -c WOKVC -e "File $rep not found."
+ }
+ }
+ return
+ }
+
+ if [info exists tabarg(-dump)] {
+ set entry [wokStore:Report:GetTrueName $ID [wokStore:Report:GetReportList $FrigoName]]
+ return [wokStore:Report:Dump $FrigoName/$entry]
+ }
+
+ set trig [info exists tabarg(-trig)]
+ set trigexist [wokStore:Trigger:Exists $fshop]
+ if { $trigexist != {} } {
+ set ask [wokStore:Trigger:Invoke $fshop allways_activate {}]
+ if { $ask == 0 } {
+ if { $trig == 0 } {
+ set trigger {}
+ } else {
+ set trigger $trigexist
+ }
+ } else {
+ set trigger $trigexist
+ }
+ } else {
+ if { $trig != 0 } {
+ msgprint -c WOKVC -w "Option -trig ignored. No trigger was declared for $fshop"
+ }
+ set trigger {}
+ }
+
+ set ID [lindex $ID 0]
+ if [file exists $ID] {
+ set TID [file tail $ID]
+ set entry [wokStore:Report:GetUniqueName $TID]
+ if { $entry != {} } {
+ if { [wokStore:Report:Add $ID $FrigoName/${entry}_TMP _TMP] != -1 } {
+ if { [catch { frename $FrigoName/${entry}_TMP $FrigoName/${entry} }] == 0 } {
+ msgprint -c WOKVC -i "Report $TID has been stored in queue $inqueue."
+ if { $trigger != {} } {
+ wokStore:Trigger:Invoke $fshop put $FrigoName/${entry}
+ }
+ } else {
+ msgprint -c WOKVC -e "(rename) during storage of $TID"
+ }
+ } else {
+ msgprint -c WOKVC -e "(write) during storage of $TID"
+ catch { exec rm -rf $FrigoName/${entry}_TMP }
+ }
+ } else {
+ msgprint -c WOKVC -e "Report name $ID should not contains a comma."
+ }
+ } else {
+ msgprint -c WOKVC -e "File $ID not found."
+ }
+ return
+}
+#;>
+# Retourne la table des elements dupliques dans la queue d'integration
+#;<
+proc wokStore:Report:InitState { FrigoName table } {
+ upvar $table tabdup
+ catch {unset tabud}
+ wokStore:Report:DumpQueue $FrigoName tabud
+ if { [array exist tabud] } {
+ catch {unset tabdup}
+ foreach key [array names tabud] {
+ if { [llength $tabud($key)] > 1 } {
+ foreach e $tabud($key)] {
+ set h [wokStore:Report:Head $e]
+ if [info exists tabdup($h)] {
+ set ll $tabdup($h)
+ } else {
+ set ll {}
+ }
+ lappend ll $key
+ set tabdup($h) $ll
+ }
+ }
+ }
+ }
+ return
+}
+#;>
+# Formatte une entry dupliquee, uniquement pour la commande Tcl.
+#;<
+proc wokStore:Report:Fmtdup { report list duplic } {
+ upvar $duplic tabfmt
+ foreach itm $list {
+ set lt [split $itm :]
+ set ud [lindex $lt 1]
+ if [info exists tabfmt($ud)] {
+ set ll $tabfmt($ud)
+ } else {
+ set ll {}
+ }
+ lappend ll [lindex $lt 0]
+ set tabfmt($ud) $ll
+ }
+ return
+}
+#;>
+# Appel un trigger pour wstore
+#;<
+proc wokStore:Trigger:Invoke { fshop action report_path } {
+ set trignam [wokStore:Trigger:Exists $fshop]
+ if { $trignam != {} } {
+ uplevel #0 source $trignam
+ ;#msgprint -c WOKVC -i "Invoking file $trignam."
+ if { [catch { wstore_trigger $action $report_path } trigval ] == 0 } {
+ ;#msgprint -c WOKVC -i "Trigger $trignam successfully completed"
+ return $trigval
+ } else {
+ msgprint -c WOKVC -e "Error in trigger: $trigval"
+ return {}
+ }
+ }
+
+ return
+}
+#;>
+# Retourne si il y en a un le trigger associe a shop
+#
+#;<
+proc wokStore:Trigger:Exists { fshop } {
+ set trignam [wokinfo -p AdmDir ${fshop}]/wstore_trigger.tcl
+ if { [file exists $trignam] } {
+ return $trignam
+ } else {
+ return {}
+ }
+}
+#;>
+# Repond un si path pourra ( a priori ) etre mis dans une base
+# de n'importe quel type (SCCS, RCS)
+# Pour l'instant exclut les directories.
+#;<
+proc wokStore:Report:FOK { path } {
+ return [expr { ![file isdirectory $path] }]
+}
+#;>
+# Ajoute un report dans un frigo
+# 1. Creation du repertoire associe
+# 3. Ecriture des report-work et de ReleaseNotes
+# 4. Gel des sources dans leur repertoire associe.
+#;<
+proc wokStore:Report:Add { ID frigo sfx} {
+ catch { unset table banner notes }
+ wokPrepare:Report:Read $ID table banner notes
+ set writact $banner
+ mkdir -path $frigo
+ chmod 0777 $frigo
+ regsub ${sfx}$ $frigo "" pthfrig
+ set LST [lsort [array names table]]
+ foreach e $LST {
+ msgprint -c WOKVC -i [format "Processing unit : %s" $e]
+ mkdir -path $frigo/$e
+ chmod 0777 $frigo/$e
+ lappend writact "* $e"
+ foreach l $table($e) {
+ set str [wokUtils:LIST:Trim $l]
+ set flag [lindex $str 0]
+ set file [lindex $str 3]
+ set orig [lindex $str 4]
+ if { [wokStore:Report:FOK $orig/$file] } {
+ switch -- $flag {
+ - {
+ lappend writact "- /dev/null/$file"
+ }
+ + {
+ if { [wokUtils:FILES:copy $orig/$file $frigo/$e/$file] != -1 } {
+ chmod 0777 $frigo/$e/$file
+ lappend writact "+ $pthfrig/$e/$file"
+ } else {
+ return -1
+ }
+ }
+ = {
+ ;#puts stderr "Warning:File $file not modified. Ignored"
+ }
+ # {
+ if { [wokUtils:FILES:copy $orig/$file $frigo/$e/$file] != -1 } {
+ chmod 0777 $frigo/$e/$file
+ lappend writact "# $pthfrig/$e/$file"
+ } else {
+ return -1
+ }
+ }
+ >>> {
+ }
+ default {
+ msgprint -c WOKVC -w "Ignored line: $l"
+ }
+ }
+ } else {
+ msgprint -c WOKVC -w "Directory $file not processed."
+ }
+ }
+ }
+ wokUtils:FILES:copy $ID $frigo/report-orig
+ wokUtils:FILES:ListToFile $writact $frigo/report-work
+ wokUtils:FILES:ListToFile $notes $frigo/report-notes
+ chmod 0777 [list $frigo/report-orig $frigo/report-work $frigo/report-notes]
+ return 1
+}
+#;>
+# Retourne une map tif(unit.t) { {source toto.c /a/b/toto.c} ... }
+# cree a partir d'un report filename. Utilise par wpack -rep
+#;<
+proc wokStore:Report:Pack { fileid filename verbose } {
+ catch { unset table banner notes }
+ wokPrepare:Report:InitTypes
+ wokPrepare:Report:Read $filename table banner notes
+ set writact $banner
+ set LST [lsort [array names table]]
+ foreach e $LST {
+ set ll {}
+ lappend writact "* $e"
+ foreach l $table($e) {
+ set str [wokUtils:LIST:Trim $l]
+ set flag [lindex $str 0]
+ set file [lindex $str 3]
+ switch -- $flag {
+ - {
+ lappend ll [list source $file [lindex $str 5]/$file]
+ lappend writact "# [lindex $str 5]/$file"
+ }
+ + {
+ lappend ll [list source $file [lindex $str 4]/$file]
+ lappend writact "# [lindex $str 4]/$file"
+ }
+ = {
+ lappend ll [list source $file [lindex $str 4]/$file]
+ lappend writact "# [lindex $str 4]/$file"
+ }
+ # {
+ lappend ll [list source $file [lindex $str 4]/$file]
+ lappend writact "# [lindex $str 4]/$file"
+ }
+
+ default {
+ msgprint -c WOKVC -w "Ignored line: $l"
+ }
+ }
+ }
+ set str [wokPrepare:Report:UnitHeader tolong $e]
+ set typ [lindex $str 0]
+ set nam [lindex $str 1]
+ if { $verbose } { msgprint -c WOKVC -i "Packing $typ $nam..." }
+ puts $fileid [format "=!=!=!=!=!=!=!=!=!=! %s %s" $typ $nam]
+ upack:Fold $ll $fileid [upack:Upackable] 0
+ }
+ puts $fileid [format "=!=!=!=!=!=!=!=!=!=! report-orig report-orig"]
+ puts $fileid "=+=+=+=+=+=+=+=+=+=+ source report-orig"
+ foreach x [wokUtils:FILES:FileToList $filename] { puts $fileid $x }
+ puts $fileid "=!=!=!=!=!=!=!=!=!=! report-notes report-notes"
+ puts $fileid "=+=+=+=+=+=+=+=+=+=+ source report-notes"
+ foreach x $notes { puts $fileid $x }
+ puts $fileid "=!=!=!=!=!=!=!=!=!=! report-work report-work"
+ puts $fileid "=+=+=+=+=+=+=+=+=+=+ source report-work"
+ foreach x $writact { puts $fileid $x }
+ return
+}
+#;>
+# Inverse du precedent.
+#;<
+proc wokStore:Report:UnPack { fileid frigo } {
+ wokPrepare:Report:InitTypes
+ set origact [set writact [wokPrepare:Report:ListInfo unknown unknown unknown]]
+ while {[gets $fileid line] >= 0 } {
+ if { [regexp {^=\+=\+=\+=\+=\+=\+=\+=\+=\+=\+ ([^ ]*) ([^ ]*)} $line ignore type name] } {
+ if [info exist fileout] {catch {close $fileout; unset fileout } }
+ if ![catch { set fileout [open $curdir/$name w] } errout] {
+ lappend writact "# $curdir/$name"
+ lappend origact " $name"
+ } else {
+ msgprint -e "$errout"
+ return -1
+ }
+ } elseif {[regexp {^=!=!=!=!=!=!=!=!=!=! ([^ ]*) ([^ ]*)} $line ignore utyp unam]} {
+ if [string match report-* $utyp] {
+ set curdir $frigo
+ } else {
+ set curdir $frigo/${unam}.[set s [wokPrepare:Report:UnitHeader ltos $utyp]]
+ msgprint -c WOKVC -i [format "Processing unit : %s" ${unam}.${s}]
+ catch { mkdir -path $curdir }
+ lappend writact "* ${unam}.${s}"
+ lappend origact "\n * ${unam} ($utyp):\n"
+ }
+ } else {
+ if [info exist fileout] {
+ puts $fileout $line
+ }
+ }
+
+ }
+ if [info exist fileout] {catch {close $fileout; unset fileout} }
+
+ if ![file exists $frigo/report-work] {
+ wokUtils:FILES:ListToFile $writact $frigo/report-work
+ }
+
+ if ![file exists $frigo/report-notes] {
+ set cmt [wokIntegre:Journal:EditReleaseNotes [id user] {It was a workbench backup(wpack)}]
+ wokUtils:FILES:ListToFile $cmt $frigo/report-notes
+ }
+
+ if ![file exists $frigo/report-orig] {
+ set cmt [wokIntegre:Journal:EditReleaseNotes [id user] {This is a workbench backup(wpack)}]
+ wokUtils:FILES:ListToFile [concat $origact $cmt] $frigo/report-orig
+ }
+
+ chmod 0777 [list $frigo/report-orig $frigo/report-work $frigo/report-notes]
+ return
+}
+#;>
+# Retire un report du frigo, le report est donne par son full path
+#;<
+proc wokStore:Report:Del { LISTREPORT {forced -1} } {
+ foreach entry $LISTREPORT {
+ if { [file owned $entry] || $forced != -1 } {
+ if { [wokStore:Report:RmEntry $entry] == -1 } {
+ return -1
+ }
+ } else {
+ msgprint -c WOKVC -e "You are not the owner of this report."
+ return -1
+ }
+ }
+ return
+}
+#;>
+# Detruit effectivement une entry (full path) dans la queue.
+#;<
+proc wokStore:Report:RmEntry { fullentry } {
+ foreach itm [glob -nocomplain $fullentry/*] {
+ if [file isdirectory $itm] {
+ wokUtils:FILES:removedir $itm
+ }
+ }
+ wokUtils:FILES:removedir $fullentry
+ return
+}
+
+#;>
+# retourne une table table(ud) = {R1/ud R2/ud etcc }
+#;<
+proc wokStore:Report:Cross { R table } {
+ upvar $table TLOC
+ set excep [list report-notes report-orig report-work]
+ if { $R != {} } {
+ foreach r [glob -nocomplain $R/*/*] {
+ set ud [file tail $r]
+ if { [lsearch $excep $ud] == -1 } {
+ if [info exists TLOC($ud)] {
+ set l $TLOC($ud)
+ } else {
+ set l {}
+ }
+ lappend l $r
+ set TLOC($ud) $l
+ }
+ }
+ }
+ return
+}
+#;>
+# Cree une table avec le contenu de la queue
+# Table(file:ud) { liste des directories concernees }
+# Si longueur de la liste > 1 => duplication
+#;<
+proc wokStore:Report:DumpQueue { FrigoName table } {
+ upvar $table TLOC
+ catch { unset tabud }
+ wokStore:Report:Cross $FrigoName tabud
+ if [array exists tabud] {
+ foreach ud [array names tabud] {
+ foreach dir $tabud($ud) {
+ if [file exists $dir] {
+ foreach f [readdir $dir] {
+ set key ${f}:${ud}
+ if [info exists TLOC($key)] {
+ set ll $TLOC($key)
+ } else {
+ set ll {}
+ }
+ lappend ll $dir
+ set TLOC($key) $ll
+ }
+ }
+ }
+ }
+ }
+ return
+}
+#;>
+#
+# Retourne le full path de la racine de la file de nom name. Ce path se trouve dans la variable EDL
+# VC_<name>.
+#;<
+proc wokStore:Report:GetQName { fshop name {create 0} } {
+ if { [lsearch {TYPE ROOT WBROOT DEFAULT EDL} $name] == -1 } {
+ set pth {}
+ catch { set pth [wokparam -e %VC_${name} $fshop] }
+ if { $pth != {} } {
+ set diradm [file join $pth FRIGO]
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating file $diradm"
+ mkdir -path $diradm
+ chmod 0777 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+ } else {
+ return {}
+ }
+ } else {
+ msgprint -c WOKVC -e "The string $name should not be used as a queue name."
+ return {}
+ }
+}
+
+#;>
+#
+# Retourne le full path de la racine ou on accroche les reports pour le "gel" des sources d'un ilot.
+# 1. Si create = 1 le cree dans le cas ou il n'existe pas.
+#;<
+proc wokStore:Report:GetRootName { fshop {create 0} } {
+ set root [wokStore:Report:GetAdmName $fshop $create]/FRIGO
+ if [file exists $root] {
+ return $root
+ } else {
+ if { $create } {
+ mkdir -path $root
+ chmod 0777 $root
+ return $root
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# Retourne le full path du repertoire d'administration de wstore pour un ilot donne.
+# 1. Si create = 1 le cree dans le cas ou il n'existe pas.
+#;<
+proc wokStore:Report:GetAdmName { fshop {create 0} } {
+ set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]
+ if [file exists $diradm] {
+ return $diradm
+ } else {
+ if { $create } {
+ msgprint -c WOKVC -i "Creating file $diradm"
+ mkdir -path $diradm
+ chmod 0777 $diradm
+ return $diradm
+ } else {
+ return {}
+ }
+ }
+}
+#;>
+# Pour debugger. Imprime tout ce qui se trouve accroche sous ID
+#;<
+proc wokStore:Report:Dump { D } {
+ return [exec find $D -print]
+}
+#;>
+# Retourne le nom de l'entry associee a ReportID {} sinon
+#;<
+proc wokStore: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 WOKVC -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) "
+ return {}
+ }
+ } else {
+ msgprint -c WOKVC -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) "
+ return {}
+ }
+ } else {
+ msgprint -c WOKVC -e "Report Queue is empty."
+ return {}
+
+ }
+}
+#;>
+#
+# Retourne un nom de directory unique base sur l'heure /append le nom du report
+#
+#;<
+proc wokStore: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 wokStore:Report:GetPrettyName { Uniquename } {
+ set l [split $Uniquename ,]
+ return [list [lindex $l 1] [fmtclock [lindex $l 0]] ]
+}
+
+#;>
+# Retourne la liste des reports ordonnee par rapport a leur date d'arrivee
+#;<
+proc wokStore:Report:GetReportList { FrigoName } {
+ if [file exists $FrigoName] {
+ return [lsort -command wokStore:Report:SortEntry [readdir $FrigoName] ]
+ } else {
+ return {}
+ }
+}
+#;>
+# Retourne l'index dans la queue d'un report -1 si existe pas
+#;<
+proc wokStore:Report:Index { FrigoName Truename } {
+ set i [lsearch [wokStore: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 wokStore: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 wokStore:Report:QueueLength { fshop } {
+ return [llength [wokStore:Report:GetReportList [wokStore:Report:GetRootName $fshop]]]
+}
+
+#;>
+# Commande utilise pour le tri ci dessus: (u,string1 > v,string2 <=> u > v)
+#;<
+proc wokStore:Report:SortEntry { a b } {
+ set lna [split $a ,]
+ set lnb [split $b ,]
+ return [expr [lindex $lna 0] - [lindex $lnb 0] ]
+}
+#;>
+# Lit un report enregistre par wstore, remplit une table
+# TABLE(UD.TYPE) = {liste des items de l'UD}
+# Item = {[+|-|=|# full path}
+# Il n'y a qu'un path par item, c'est l'adresse dans le frigo du fichier
+# a traiter
+#
+# Si OPT = ref a)Verifie que tous les items du report sont + sinon retourne une erreur
+# b)Retire le flag + dans table (implicite)
+#;<
+proc wokStore:Report:Process { {OPT normal} RepName table info notes} {
+ upvar $table TLOC $info lloc $notes ntloc
+ set lf [wokUtils:FILES:FileToList ${RepName}/report-work]
+ set ntloc [wokUtils:FILES:FileToList ${RepName}/report-notes]
+ set lloc [lrange $lf 0 2]
+ set lact [lrange $lf 3 end]
+ switch $OPT {
+ normal {
+ foreach x $lact {
+ set header [regexp {\* (.*)} $x all ut]
+ if { $header } {
+ set key $ut
+ set TLOC($key) {}
+ } else {
+ set l $TLOC($key)
+ set elm [list [lindex $x 0] [file join $RepName $key [file tail [lindex $x 1]]]]
+ set TLOC($key) [lappend l $elm]
+ }
+ }
+ return 0
+ }
+
+ ref {
+ foreach x $lact {
+ set header [regexp {\* (.*)} $x all ut]
+ if { $header } {
+ set key $ut
+ set TLOC($key) {}
+ } else {
+ set flg [lindex $x 0]
+ if { $flg == {+} } {
+ set l $TLOC($key)
+ set elm [file join $RepName $key [file tail [lindex $x 1]]]
+ set TLOC($key) [lappend l $elm]
+ } else {
+ msgprint -c WOKVC -e "Bad flag for this kind of operation ($x).Should be marked {+}."
+ return -1
+ }
+ }
+ }
+ return 0
+ }
+ }
+}
+;#
+;# Retourne un ou plusieurs pathes de report, mangeables par wokStore:Report:Process
+;#
+proc wokStore:Report:Get { id fshop } {
+ set l {}
+ if { [wokStore:Report:QueueLength $fshop] != 0 } {
+ set FrigoName [wokStore:Report:GetRootName $fshop]
+ if { $FrigoName != {} } {
+ set ListReport [wokStore:Report:GetReportList $FrigoName]
+ if { $ListReport != {} } {
+ if { "$id" == "all" } {
+ foreach e $ListReport {
+ lappend l $FrigoName/$e
+ }
+ } else {
+ set brep [wokStore:Report:GetTrueName $id $ListReport]
+ if { "$brep" != "" } {
+ lappend l $FrigoName/$brep
+ }
+ }
+ } else {
+ msgprint -c WOKVC -e "Unable to get report list."
+ }
+ } else {
+ msgprint -c WOKVC -e "Administration directory for $fshop not found. No report was stored."
+ }
+ } else {
+ msgprint -c WOKVC -i "Report queue is empty or workshop not found."
+ }
+ return $l
+}
+;#
+;# Renvoie 1 si on peut faire store dans une queue associee au workbench.
+;# Pour l'instant workbench racine
+;#
+proc wokStore:Queue:Enabled { shop wb } {
+ if { "[wokIntegre:RefCopy:GetWB ${shop}]" == "$wb" } {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+
+;#
+;# Fait ls d'une file qname. Si qname = {} ls de la file de l'ilot.
+;#
+proc wokStore:Report:LS { FrigoName } {
+ set i 0
+ wokStore:Report:InitState $FrigoName tabdup
+ foreach e [wokStore:Report:GetReportList $FrigoName] {
+ set user [wokUtils:FILES:Userid $FrigoName/$e]
+ set str [wokStore: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 ]
+ if [info exists tabdup($e)] {
+ catch {unset dupfmt }
+ wokStore:Report:Fmtdup $FrigoName/$e $tabdup($e) dupfmt
+ foreach u [lsort [array names dupfmt]] {
+ puts " [lindex [split $u .] 0]:"
+ foreach f $dupfmt($u) {
+ puts " $f ($FrigoName/$e/${u}/${f})"
+ }
+ }
+ }
+ } else {
+ msgprint -c WOKVC -e "Bad entry ($e) found in report.list"
+ }
+ }
+}
+
+;#
+;# Queue -> Tar retourne 1 si OK tarfile n'est pas compresse
+;#
+proc wokStore:Queue:Tar { FrigoName tarfile } {
+ set savpwd [pwd]
+ cd $FrigoName
+ set stat [wokUtils:EASY:tar tarfromroot $tarfile .]
+ cd $savpwd
+ return $stat
+}
+;#
+;# Tar -> Queue retourne 1 si OK, tarfile est decompresse
+;#
+proc wokStore:Queue:Untar { tarfile FrigoName {verbose 0} } {
+ set tmpfrig [wokUtils:FILES:tmpname TMPFRIG]
+ catch { exec rm -rf $tmpfrig } statrm
+ catch { mkdir -path $tmpfrig } statmk
+
+ if [file exists $tmpfrig] {
+ set savpwd [pwd]
+ cd $tmpfrig
+ set stat [wokUtils:EASY:tar untar $tarfile]
+ set ListReport [wokStore:Report:GetReportList $tmpfrig]
+ set inx 0
+ foreach e $ListReport {
+ set label [getclock],[lindex [split $e ,] 1]
+ if [catch { exec cp -rp $tmpfrig/$e $FrigoName/$label } status] {
+ msgprint -c WOKVC -e "$status"
+ } else {
+ if { $verbose == 1 } {
+ msgprint -c WOKVC -i "Report [incr inx] has been restored."
+ }
+ }
+ }
+ cd $savpwd
+ catch { exec rm -rf $tmpfrig }
+
+ if { $verbose == 1 } {
+ msgprint -c WOKVC -i "A total of $inx reports has been restored."
+ }
+ return $inx
+ } else {
+ return 0
+ }
+}
+;#
+;# Parametres
+;#
+#;>
+# Retourne le type de la base courante. {} sinon => utiliser ca pour savoir si il y en une !!
+#;<
+proc wokStore:Report:GetType { fshop {dump 0} } {
+ set lvc [wokparam -l VC $fshop]
+ if { $lvc != {} } {
+ if { [lsearch -regexp $lvc %VC_TYPE=*] != -1 } {
+ if { $dump } {
+ foreach dir [wokparam -L $fshop] {
+ if [file exists $dir/VC.edl] {
+ msgprint -c WOKVC -i "Following definitions in file : $dir/VC.edl"
+ break
+ }
+ }
+ msgprint -c WOKVC -i "Repository root : [wokparam -e %VC_ROOT $fshop]"
+ msgprint -c WOKVC -i "Repository type : [wokparam -e %VC_TYPE $fshop]"
+ msgprint -c WOKVC -i "Default queue : [wokStore:Report:GetRootName $fshop]"
+ msgprint -c WOKVC -i "Attached to : [wokIntegre:RefCopy:GetWB $fshop]\n"
+
+ foreach nam $lvc {
+ if [regsub {^%VC_} $nam {} msg] {
+ set t [split $msg =]
+ if { [lsearch {TYPE ROOT WBROOT DEFAULT EDL} [lindex $t 0] ] == -1 } {
+ msgprint -c WOKVC -i "[lindex $t 0] : [lindex $t 1]"
+ }
+ }
+ }
+
+ }
+ return [wokparam -e %VC_TYPE $fshop]
+ } else {
+ return {}
+ }
+ } else {
+ return {}
+ }
+}
--- /dev/null
+#
+# Convert a date
+# 07/03/96 11:55 => "07 Mar 96 11:55"
+#
+proc wokUtils:TIME:dpe { dpedateheure } {
+ set dt(01) Jan;set dt(02) Feb;set dt(03) Mar;set dt(04) Apr;set dt(05) May;set dt(06) Jun
+ set dt(07) Jul;set dt(08) Aug;set dt(09) Sep;set dt(10) Oct;set dt(11) Nov;set dt(12) Dec
+ regexp {(.*)/(.*)/(.*) (.*)} $dpedateheure ignore day mth yea hour
+ return [convertclock "$day $dt($mth) $yea $hour"]
+}
+#
+# Returs the list of files in dir newer than date
+#
+proc wokUtils:FILES:Since { dir {date "00:00:00" }} {
+ set lim [clock scan $date]
+ set l {}
+ foreach file [ readdir $dir ] {
+ if { [file mtime $dir/$file] > $lim } {
+ lappend l $file
+ }
+ }
+ return $l
+}
+#
+# returns a list:
+# First is the date and time of more recent file in dir
+# Second is the accumulate size of all files
+#
+proc wokUtils:FILES:StatDir { dir } {
+ set s 0
+ set m [file mtime $dir]
+ foreach f [glob -nocomplain $dir/*] {
+ incr s [file size $f]
+ if { [set mf [file mtime $f]] > $m } {
+ set m $mf
+ }
+ }
+ return [list $m $s]
+}
+#
+# Returns results > 0 if f1 newer than f2
+#
+proc wokUtils:FILES:IsNewer { f1 f2 } {
+ return [ expr [file mtime $f1] - [file mtime $f2] ]
+}
+#
+# Write in table(file) the list of directories of ldir that contains file
+#
+proc wokUtils:FILES:Intersect { ldir table } {
+ upvar $table TLOC
+ foreach r $ldir {
+ foreach f [readdir $r] {
+ if [info exists TLOC($f)] {
+ set l $TLOC($f)
+ } else {
+ set l {}
+ }
+ lappend l $r
+ set TLOC($f) $l
+ }
+ }
+ return
+}
+#
+# Returns 1 if name does not begin with -
+#
+proc wokUtils:FILES:ValidName { name } {
+ return [expr ([regexp {^-.*} $name]) ? 0 : 1]
+}
+#
+# Read file pointed to by path
+# 1. sort = 1 tri
+# 2. trim = 1 plusieurs blancs => 1 seul blanc
+# 3. purge= not yet implemented.
+# 4. emptl= dont process blank lines
+#
+proc wokUtils:FILES:FileToList { path {sort 0} {trim 0} {purge 0} {emptl 1} } {
+ if ![ catch { set id [ open $path r ] } ] {
+ set l {}
+ while {[gets $id line] >= 0 } {
+ if { $trim } {
+ regsub -all {[ ]+} $line " " line
+ }
+ if { $emptl } {
+ if { [string length ${line}] != 0 } {
+ lappend l $line
+ }
+ } else {
+ lappend l $line
+ }
+ }
+ close $id
+ if { $sort } {
+ return [lsort $l]
+ } else {
+ return $l
+ }
+ } else {
+ return {}
+ }
+}
+;#
+;# Unix like find, return a list of names.
+;#
+proc wokUtils:FILES:find { dirlist gblist } {
+ set result {}
+ set recurse {}
+ foreach dir $dirlist {
+ foreach ptn $gblist {
+ set result [concat $result [glob -nocomplain -- $dir/$ptn]]
+ }
+ foreach file [readdir $dir] {
+ set file $dir/$file
+ if [file isdirectory $file] {
+ set fileTail [file tail $file]
+ if {!(($fileTail == ".") || ($fileTail == ".."))} {
+ lappend recurse $file
+ }
+ }
+ }
+ }
+ if ![lempty $recurse] {
+ set result [concat $result [wokUtils:FILES:find $recurse $gblist]]
+ }
+ return $result
+}
+;#
+;# Returns a list representation for a directory tree
+;# l = { r {sub1 .. subn} } where sub1 .. subn as l
+;#
+proc wokUtils:FILES:DirToTree { d } {
+ set flst ""
+ set pat [file join $d *]
+ foreach f [ lsort [ glob -nocomplain $pat]] {
+ if [file isdirectory $f] {
+ set cts [wokUtils:FILES:DirToTree $f]
+ } else {
+ set cts ""
+ }
+ lappend flst [list [file tail $f] $cts]
+ }
+ return $flst
+}
+;#
+;# Write in map all directories under d. Each index is a directory name ( trimmed by d).
+;# Contents of index is the list of files in that directory
+;#
+proc wokUtils:FILES:DirToMap { d map {tail 0} } {
+ upvar $map TLOC
+ catch { unset TLOC }
+ set l [wokUtils:FILES:find $d *]
+ set TLOC(.) {}
+ foreach e $l {
+ if { [file isdirectory $e] } {
+ if [regsub -- $d $e "" k] {
+ set TLOC($k) {}
+ } else {
+ puts "Error regsub -- $d $e"
+ }
+ } else {
+ set dir [file dirname $e]
+ if [regsub -- $d $dir "" k] {
+ if { $k == {} } {
+ set k .
+ }
+ if [info exists TLOC($k)] {
+ set l $TLOC($k)
+ lappend l $e
+ set TLOC($k) $l
+ } else {
+ set TLOC($k) $e
+ }
+ } else {
+ puts "Error regsub -- $d $dir"
+ }
+ }
+ }
+
+ if { $tail == 0 } { return }
+
+ foreach x [array names TLOC] {
+ set l {}
+ foreach e $TLOC($x) {
+ lappend l [file tail $e]
+ }
+ set TLOC($x) $l
+ }
+
+ return
+}
+;#
+;# Same as above but write a Tcl proc to perform it. Proc has 1 argument. the name of the map.
+;#
+proc wokUtils:FILES:DirMapToProc { d TclFile ProcName } {
+ catch { unset TLOC }
+ wokUtils:FILES:DirToMap $d TLOC 1
+ if ![ catch { set id [ open $TclFile w ] } errout ] {
+ puts $id "proc $ProcName { map } {"
+ puts $id "upvar \$map TLOC"
+ foreach x [array names TLOC] {
+ puts $id "set TLOC($x) {$TLOC($x)}"
+ }
+ puts $id "return"
+ puts $id "}"
+ close $id
+ return 1
+ } else {
+ puts stderr "$errout"
+ return -1
+ }
+}
+
+#
+# Concat all files in lsfiles. Writes the result in result
+#
+proc wokUtils:FILES:concat { result lstfile } {
+ if ![ catch { set id1 [ open $result a ] } errout ] {
+ foreach file2 $lstfile {
+ if ![ catch { set id2 [ open $file2 r ] } ] {
+ puts $id1 [read -nonewline $id2]
+ }
+ close $id2
+ }
+ close $id1
+ return 1
+ } else {
+ puts stderr "$errout"
+ return -1
+ }
+}
+#
+# returns the concatenation of lines in file <path> i.e. with the following rules:
+# If a line has format:<mark> <string> then calls func with args to get a full path
+# In all the case, append the string as is.
+#
+# Ex: wokUtils:FILES:rconcat [pwd]/file @ myfunc MS source
+#
+# with
+#
+#proc myfunc { basename_file args } {
+# set ud [lindex $args 0]
+# set type [lindex $args 1]
+# return [woklocate -f ${ud}:${type}:${basename_file}]
+#}
+#
+proc wokUtils:FILES:rconcat { path mark func args } {
+ if ![ catch { set id [ open $path r ] } errin ] {
+ while {[gets $id line] >= 0 } {
+ set sl [split $line]
+ if { "[lindex $sl 0]" == "$mark" } {
+ set file [eval $func [lindex $sl 1] $args]
+ append str [eval wokUtils:FILES:rconcat $file $mark $func $args]
+ } else {
+ append str $line \n
+ }
+ }
+ close $id
+ return $str
+ } else {
+ puts stderr "Error : $errin"
+ return ""
+ }
+}
+#
+# Creates a file. If string is not {} , writes it.
+#
+proc wokUtils:FILES:touch { path { string {} } { nonewline {} } } {
+ if [ catch { set id [ open $path w ] } status ] {
+ puts stderr "$status"
+ return 0
+ } else {
+ if { $string != {} } {
+ if { $nonewline != {} } {
+ puts -nonewline $id $string
+ } else {
+ puts $id $string
+ }
+ }
+ close $id
+ return 1
+ }
+}
+#
+# Writes a list in path.
+#
+proc wokUtils:FILES:ListToFile { liste path } {
+ if [ catch { set id [ open $path w ] } ] {
+ return 0
+ } else {
+ foreach e $liste {
+ puts $id $e
+ }
+ close $id
+ return 1
+ }
+}
+#
+# l1 U l2
+#
+proc wokUtils:LIST:union { l1 l2 } {
+ set l {}
+ foreach e [concat $l1 $l2] {
+ if { [lsearch $l $e] == -1 } {
+ lappend l $e
+ }
+ }
+ return $l
+}
+#
+# l1 - l2
+#
+proc wokUtils:LIST:moins { l1 l2 } {
+ set l {}
+ foreach e $l1 {
+ if { [lsearch $l2 $e] == -1 } {
+ lappend l $e
+ }
+ }
+ return $l
+}
+#
+# Do something i cannot remenber,
+#
+proc wokUtils:LIST:subls { list } {
+ set l {}
+ set len [llength $list]
+ for {set i 0} {$i < $len} {incr i 1} {
+ lappend l [lrange $list 0 $i]
+ }
+ return $l
+}
+#
+# { 1 2 3 } => { 3 2 1 }
+#
+proc wokUtils:LIST:reverse { list } {
+ set ll [llength $list]
+ if { $ll == 0 } {
+ return
+ } elseif { $ll == 1 } {
+ return $list
+ } else {
+ return [concat [wokUtils:LIST:reverse [lrange $list 1 end]] [list [lindex $list 0]]]
+ }
+}
+#
+# flat a list: { a {b c} {{{{d}}}e } etc..
+# => { a b c d e }
+#
+proc wokUtils:LIST:flat { list } {
+ if { [llength $list] == 0 } {
+ return {}
+ } elseif { [llength [lindex $list 0]] == 1 } {
+ return [concat [lindex $list 0] [wokUtils:LIST:flat [lrange $list 1 end]]]
+ } elseif { [llength [lindex $list 0]] > 1 } {
+ return [concat [wokUtils:LIST:flat [lindex $list 0]] [wokUtils:LIST:flat [lrange $list 1 end]]]
+ }
+}
+#
+# returns 3 lists l1-l2 l1-inter-l2 l2-l1
+#
+proc wokUtils:LIST:i3 { l1 l2 } {
+ set a1(0) {} ; unset a1(0)
+ set a2(0) {} ; unset a2(0)
+ set a3(0) {} ; unset a3(0)
+ foreach v $l1 {
+ set a1($v) {}
+ }
+ foreach v $l2 {
+ if [info exists a1($v)] {
+ set a2($v) {} ; unset a1($v)
+ } {
+ set a3($v) {}
+ }
+ }
+ list [lsort [array names a1]] [lsort [array names a2]] [lsort [array names a3]]
+}
+#
+# returns all elements of list matching of the expr in lexpr
+# Ex: GM [glob *] [list *.tcl *.cxx A*.c]
+#
+proc wokUtils:LIST:GM { list lexpr } {
+ set l {}
+ foreach expr $lexpr {
+ foreach e $list {
+ if [string match $expr $e] {
+ if { [lsearch $l $e] == -1 } {
+ lappend l $e
+ }
+ }
+ }
+ }
+ return $l
+}
+#
+# returns the longer prefix that begin with str in inlist ( Completion purpose.)
+#
+proc wokUtils:LIST:POF { str inlist } {
+ set list {}
+ foreach e $inlist {
+ if {[string match $str* $e]} {
+ lappend list $e
+ }
+ }
+ if { $list == {} } {
+ return [list {} {}]
+ }
+ set l [expr [string length $str] -1]
+ set miss 0
+ set e1 [lindex $list 0]
+ while {!$miss} {
+ incr l
+ if {$l == [string length $e1]} {
+ break
+ }
+ set new [string range $e1 0 $l]
+ foreach f $list {
+ if ![string match $new* $f] {
+ set miss 1
+ incr l -1
+ break
+ }
+ }
+ }
+ set match [string range $e1 0 $l]
+ set newlist {}
+ foreach e $list {
+ if {[string match $match* $e]} {
+ lappend newlist $e
+ }
+ }
+ return [list $match $newlist]
+}
+#
+# pos = 1 {{a b c } x} => { {x a} {x b} {x c} } default
+# pos = 2 {{a b c } x} => { {a x} {a x} {a x} }
+#
+proc wokUtils:LIST:pair { l e {pos 1}} {
+ set r {}
+ if { $pos == 1 } {
+ foreach x $l {
+ lappend r [list $e $x ]
+ }
+ } else {
+ foreach x $l {
+ lappend r [list $x $e ]
+ }
+ }
+
+ return $r
+}
+#
+# { {x a} {x b} {x c} } => {a b c}
+#
+proc wokUtils:LIST:unpair { ll } {
+ set r {}
+ foreach x $ll {
+ lappend r [lindex $x 1]
+ }
+ return $r
+}
+#
+# keep in list of form ll = { {x a} {x b} {x c} } all elements which "cdr lisp" is in l
+#
+proc wokUtils:LIST:selectpair { ll l } {
+ set rr {}
+ foreach x $ll {
+
+ if { [lsearch $l [lindex $x 1]] != -1 } {
+ lappend rr $x
+ }
+ }
+ return $rr
+}
+#
+# sort a list of pairs
+#
+proc wokUtils:LIST:Sort2 { ll } {
+ catch { unset tw }
+ foreach x $ll {
+ set e [lindex $x 0]
+ if [info exists tw($e)] {
+ set lw $tw($e)
+ lappend lw [lindex $x 1]
+ set tw($e) $lw
+ } else {
+ set tw($e) [lindex $x 1]
+ }
+ }
+ set l {}
+ foreach x [lsort [array names tw]] {
+ foreach y [lsort $tw($x)] {
+ lappend l [list $x $y]
+ }
+ }
+ return $l
+}
+#
+# Purge a list. Dont modify order
+#
+proc wokUtils:LIST:Purge { l } {
+ set r {}
+ foreach e $l {
+ if ![info exist tab($e)] {
+ lappend r $e
+ set tab($e) {}
+ }
+ }
+ return $r
+}
+#
+# trim a list
+#
+proc wokUtils:LIST:Trim { l } {
+ set r {}
+ foreach e $l {
+ if { $e != {} } {
+ set r [ concat $r $e]
+ }
+ }
+ return $r
+}
+#
+# truncates all strings in liststr which length exceed nb char
+#
+proc wokUtils:LIST:cut { liststr {nb 10} } {
+ set l {}
+ foreach str $liststr {
+ set len [string length $str]
+ if { $len <= [expr $nb + 2 ]} {
+ lappend l $str
+ } else {
+ lappend l [string range $str 0 $nb]..
+ }
+ }
+ return $l
+}
+#
+# compares 2 lists of fulls pathes (master and revision) and fill table with the following format
+# table(simple.nam) {flag path1 path2}
+# flag = + => simple.nam in master but not in revision
+# flag = ? => simple.nam in master and in revision (files should be further compared)
+# flag = - => simple.nam in revision but not in master
+#
+proc wokUtils:LIST:SimpleDiff { table master revision {gblist {}} } {
+ upvar $table TLOC
+ catch {unset TLOC}
+ foreach e $master {
+ set key [file tail $e]
+ if { $gblist == {} } {
+ set TLOC($key) [list - [file dirname $e]]
+ } elseif { [lsearch $gblist [file extension $key]] != -1 } {
+ set TLOC($key) [list - [file dirname $e]]
+ }
+ }
+ foreach e $revision {
+ set key [file tail $e]
+ set dir [file dirname $e]
+ if { $gblist == {} } {
+ if { [expr { ( [lsearch -exact [array names TLOC] $key] == -1 ) ? 0 : 1 }] } {
+ set TLOC($key) [list ? [lindex $TLOC($key) 1] $dir]
+ } else {
+ set TLOC($key) [list + $dir]
+ }
+ } elseif { [lsearch $gblist [file extension $key]] != -1 } {
+ if { [expr { ( [lsearch -exact [array names TLOC] $key] == -1 ) ? 0 : 1 }] } {
+ set TLOC($key) [list ? [lindex $TLOC($key) 1] $dir]
+ } else {
+ set TLOC($key) [list + $dir]
+ }
+ }
+ }
+ return
+}
+#
+# modify table ( created by wokUtils:LIST:SimpleDiff) as follows:
+# substitues flag ? by = if function(path1,path2) returns 1 , by # if not
+# all indexes in tbale are processed.
+#
+proc wokUtils:LIST:CompareAllKey { table function } {
+ upvar $table TLOC
+ foreach e [array names TLOC] {
+ set flag [lindex $TLOC($e) 0]
+ set f1 [lindex $TLOC($e) 1]/$e
+ set f2 [lindex $TLOC($e) 2]/$e
+ if { [string compare $flag ?] == 0 } {
+ if { [$function $f1 $f2] == 1 } {
+ set TLOC($e) [list = $f1 $f2]
+ } else {
+ set TLOC($e) [list # $f1 $f2]
+ }
+ }
+ }
+}
+#
+# Same as above but only indexex in keylist are processed.
+# This proc to avoid testing each key in the above procedure
+#
+proc wokUtils:LIST:CompareTheseKey { table function keylist } {
+ upvar $table TLOC
+ foreach e [array names TLOC] {
+ if { [expr { ([lsearch -exact $keylist $e] != -1) ? 1 : 0}] } {
+ set flag [lindex $TLOC($e) 0]
+ set f1 [lindex $TLOC($e) 1]/$e
+ set f2 [lindex $TLOC($e) 2]/$e
+ if { [string compare $flag ?] == 0 } {
+ if { [$function $f1 $f2] == 1 } {
+ set TLOC($e) [list = $f1 $f2]
+ } else {
+ set TLOC($e) [list # $f1 $f2]
+ }
+ }
+ } else {
+ unset TLOC($e)
+ }
+ }
+ return
+}
+#
+# same as array set, i guess
+#
+proc wokUtils:LIST:ListToMap { name list2 } {
+ upvar $name TLOC
+ foreach f $list2 {
+ set TLOC([lindex $f 0]) [lindex $f 1]
+ }
+ return
+}
+#
+# reverse
+#
+proc wokUtils:LIST:MapToList { name {reg *}} {
+ upvar $name TLOC
+ set l {}
+ foreach f [array names TLOC $reg] {
+ lappend l [list $f $TLOC($f)]
+ }
+ return $l
+}
+#
+# Same as wokUtils:LIST:ListToMap. For spurious reason
+#
+proc wokUtils:LIST:MapList { name list2 } {
+ upvar $name TLOC
+ foreach f $list2 {
+ set TLOC([lindex $f 0]) [lindex $f 1]
+ }
+ return
+}
+
+#
+# Applique le test Func sur l'element index de list
+#
+proc wokUtils:LIST:Filter { list Func {index 0} } {
+ set l {}
+ foreach e $list {
+ if { [$Func [lindex $e $index]] } {
+ lappend l $e
+ }
+ }
+ return $l
+}
+#
+# Compares 2 full pathes for TEXT ASCII files. Returs 1 if identicals 0 ifnot
+#
+proc wokUtils:FILES:AreSame { f1 f2 } {
+ set ls1 [file size $f1]
+ set ls2 [file size $f2]
+ if { $ls1 == $ls2 } {
+ set id1 [open $f1 r]
+ set id2 [open $f2 r]
+ set s1 [read $id1 $ls1]
+ set s2 [read $id2 $ls2]
+ close $id1
+ close $id2
+ if { $s1 == $s2 } {
+ return 1
+ } else {
+ return 0
+ }
+
+ } else {
+ return 0
+ }
+}
+#
+# Renvoie 1 si wb est une racine 0 sinon
+#
+proc wokUtils:WB:IsRoot { wb } {
+ return [expr { ( [llength [w_info -A $wb]] > 1 ) ? 0 : 1 }]
+}
+#
+# Copy file
+#
+proc wokUtils:FILES:copy { fin fout } {
+ if { [catch { set in [ open $fin r ] } errin] == 0 } {
+ if { [catch { set out [ open $fout w ] } errout] == 0 } {
+ set nb [copyfile $in $out]
+ close $in
+ close $out
+ return $nb
+ } else {
+ puts stderr "Error: $errout"
+ return -1
+ }
+ } else {
+ puts stderr "Error: $errin"
+ return -1
+ }
+}
+#
+# Returns a list of selected files
+#
+proc wokUtils:FILES:ls { dir {select all} } {
+ set l {}
+ if { [file exists $dir] } {
+ foreach f [readdir $dir] {
+ set e [file extension $f]
+ switch -- $select {
+ all {
+ if {![regexp {[^~]~$} $f] && ![string match *.*-sav* $e]} {
+ lappend l $f
+ }
+ }
+
+ cdl {
+ if { [string compare $e .cdl] == 0 } {
+ lappend l $f
+ }
+ }
+
+ cxx {
+ if { [string compare $e .cxx] == 0 } {
+ lappend l $f
+ }
+ }
+
+ others {
+ if { [string compare $e .cdl] !=0 && [string compare $e .cxx] != 0 } {
+ lappend l $f
+ }
+ }
+
+ }
+ }
+ }
+ return [lsort $l]
+}
+#
+# Compress /decompress fullpath
+#
+proc wokUtils:FILES:compress { fullpath } {
+ if [catch {exec compress -f $fullpath} status] {
+ puts stderr "Error while compressing ${fullpath}: $status"
+ return -1
+ } else {
+ return 1
+ }
+}
+proc wokUtils:FILES:uncompress { fullpath } {
+ if [catch {exec uncompress -f $fullpath} status] {
+ puts stderr "Error while uncompressing ${fullpath}: $status"
+ return -1
+ } else {
+ return 1
+ }
+}
+
+#
+# Uncompresse if applicable Zin in dirout, returns the full path of uncompressed file
+# ( if Zin is not compresses returns Zin)
+# returns -1 if an error occured
+#
+proc wokUtils:FILES:SansZ { Zin } {
+ if { [file exists $Zin] } {
+ if {[string compare [file extension $Zin] .Z] == 0 } {
+ set dirout [wokUtils:FILES:tmpname {}]
+ set bnaz [file tail $Zin]
+ if { [string compare $Zin $dirout/$bnaz] != 0 } {
+ wokUtils:FILES:copy $Zin $dirout/$bnaz
+ }
+ if { [wokUtils:FILES:uncompress $dirout/$bnaz] != -1 } {
+ return $dirout/[file root $bnaz]
+ } else {
+ return -1
+ }
+ } else {
+ return $Zin
+ }
+ } else {
+ puts stderr "Error: $Zin does not exists."
+ return -1
+ }
+}
+#
+# uuencode
+#
+proc wokUtils:FILES:uuencode { fullpathin fullpathout {codename noname}} {
+ if {[string compare $codename noname] == 0} {
+ set codename [file tail $fullpathin]
+ }
+ if [catch {exec uuencode $fullpathin $codename > $fullpathout } status] {
+ puts stderr "Error while encoding ${fullpathin}: $status"
+ return -1
+ } else {
+ return 1
+ }
+}
+#
+# uudecode
+#
+proc wokUtils:FILES:uudecode { fullpathin {dirout noname}} {
+ if {[string compare $dirout noname] == 0} {
+ set dirout [file dirname $fullpathin]
+ }
+ set savpwd [pwd]
+ cd $dirout
+ if [catch {exec uudecode $fullpathin} status] {
+ set ret -1
+ } else {
+ set ret 1
+ }
+ cd $savpwd
+ return $ret
+}
+#
+# Returns something != -1 if file must be uuencoded
+#
+proc wokUtils:FILES:Encodable { file } {
+ return [lsearch {.xwd .rgb .o .exe .a .so .out .Z .tar} [file extension $file]]
+}
+#
+# remove a directory. One level. Very ugly procedure. Do not use.
+# Bricolage pour que ca marche sur NT.
+#
+proc wokUtils:FILES:removedir { d } {
+ global env
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ if { [file exists $d] } {
+ foreach f [readdir $d] {
+ unlink -nocomplain $d/$f
+ }
+ rmdir -nocomplain $d
+ }
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ if { [file exists $d] } {
+ foreach f [readdir $d] {
+ file delete $d/$f
+ }
+ file delete $d
+
+ }
+ }
+ return
+}
+#
+# returns a string used for temporary directory name
+#
+proc wokUtils:FILES:tmpname { name } {
+ global env
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ return [file join /tmp $name]
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ return [file join $env(TMP) $name]
+ }
+ return {}
+}
+#
+# userid.
+#
+proc wokUtils:FILES:Userid { file } {
+ global env
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ file stat $file myT
+ if ![ catch { id convert userid $myT(uid) } result ] {
+ return $result
+ } else {
+ return unknown
+ }
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ return unknown
+ }
+}
+#
+# Try to supply a nice diff utility name
+#
+proc wokUtils:FILES:MoreDiff { } {
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ if [wokUtils:EASY:INPATH xdiff] {
+ return xdiff
+ } else {
+ return {}
+ }
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ return windiff
+ } else {
+ return {}
+ }
+}
+#
+# dirtmp one level
+#
+proc wokUtils:FILES:dirtmp { tmpnam } {
+ if [file exist $tmpnam] {
+ wokUtils:FILES:removedir $tmpnam
+ }
+ mkdir $tmpnam
+ return
+}
+#
+# Doc
+#
+proc wokH { reg } {
+ global auto_index
+ set maxl 0
+ set l {}
+ foreach name [lsort [array names auto_index $reg]] {
+ lappend l $name
+ if {[string length $name] > $maxl} {
+ set maxl [string length $name]
+ }
+ }
+ foreach name [lsort $l] {
+ puts stdout [format "%-*s = %s" $maxl $name [lindex $auto_index($name) 1]]
+ }
+ return
+}
+#
+# Easy 1. Stupid. Dont use
+#
+proc wokUtils:EASY:Apply { f l } {
+ if { $l != {} } {
+ $f [lindex $l 0]
+ wokUtils:EASY:Apply $f [lrange $l 1 end]
+ return
+ }
+}
+#
+# Very,very,very,very,very useful
+#
+proc wokUtils:EASY:GETOPT { prm table tablereq usage listarg } {
+
+ upvar $table TLOC $tablereq TRQ $prm PARAM
+ catch {unset TLOC}
+
+ set fill 0
+
+ foreach e $listarg {
+ if [regexp {^-.*} $e opt] {
+ if [info exists TRQ($opt)] {
+ set TLOC($opt) {}
+ set fill 1
+ } else {
+ puts stderr "Error: Unknown option $e"
+ eval $usage
+ return -1
+ }
+ } else {
+ if [info exist opt] {
+ set fill [regexp {value_required:(.*)} $TRQ($opt) all typ]
+ if { $fill } {
+ if { $TLOC($opt) == {} } {
+ set TLOC($opt) $e
+ set fill 0
+ } else {
+ lappend PARAM $e
+ }
+ } else {
+ lappend PARAM $e
+ }
+ } else {
+ lappend PARAM $e
+ }
+ }
+ }
+
+ if [array exists TLOC] {
+ foreach e [array names TLOC] {
+ if { [regexp {value_required:(.*)} $TRQ($e) all typ ] == 1 } {
+ if { $TLOC($e) == {} } {
+ puts "Error: Option $e requires a value"
+ eval $usage
+ return -1
+ }
+ switch -- $typ {
+
+ file {
+ }
+
+ string {
+ }
+
+ date {
+ }
+
+ list {
+ set TLOC($e) [split $TLOC($e) ,]
+ }
+
+ number {
+ if ![ regexp {^[0-9]+$} $TLOC($e) n ] {
+ puts "Error: Option $e requires a number."
+ eval $usage
+ return -1
+ }
+ }
+
+ }
+
+ }
+ }
+ } else {
+ foreach d [array names TRQ] {
+ if { "$TRQ($d)" == "default" } {
+ set TLOC($d) {}
+ }
+ }
+ }
+
+ return
+}
+;#
+;# Disallow 2 qualifiers
+;#
+proc wokUtils:EASY:DISOPT { tabarg tbldis usage } {
+ upvar $tabarg TARG $tbldis TDIS
+ set largs [array names TARG]
+ foreach o $largs {
+ if [info exists TDIS($o)] {
+ set lo $TDIS($o)
+ foreach y $largs {
+ if { [set inx [lsearch $lo $y]] != -1 } {
+ puts "Option $o and [lindex $lo $inx] are mutually exclusive."
+ eval $usage
+ return -1
+ }
+ }
+ }
+ }
+ return
+}
+;#
+;#
+;#
+proc wokUtils:EASY:Check_auto_path { auto_path } {
+ foreach d [wokUtils:LIST:Purge $auto_path] {
+ if [file exists $d/tclIndex] {
+ puts "tclIndex in $d"
+ } elseif [file exists $d/pkgIndex.tcl] {
+ puts "pkgIndex.tcl in $d"
+ } else {
+ puts "ERROR: $d"
+ }
+ }
+ return
+}
+
+#
+# string trim does not work. Do it
+#
+proc wokUtils:EASY:sb { str } {
+ set a ""
+ set len [string length $str]
+ for {set i 0} {$i < $len} {incr i 1} {
+ set x [string index $str $i]
+ if { $x != " " } {
+ append a $x
+ }
+ }
+ return $a
+}
+#
+# returns 1 if exec is in the path
+#
+proc wokUtils:EASY:INPATH { exec } {
+ if { [set x [auto_execok $exec]] != {} } {
+ if { $x != 0 } {
+ return 1
+ }
+ }
+ return 0
+}
+#
+# Insert a MAP in an other MAP to the index here
+#
+proc wokUtils:EASY:MAD { table here t } {
+ upvar $table TLOC $t tin
+ foreach hr [array names TLOC ${here}*] {
+ catch { unset TLOC($hr)}
+ }
+ foreach v [array names tin] {
+ set TLOC($here,$v) $tin($v)
+ }
+}
+#
+# Exec command. VERBOSE = 1 et WATCHONLY 1 => display but dont execute
+#
+proc wokUtils:EASY:command { command {VERBOSE 0} {WATCHONLY 0} } {
+ if { $VERBOSE } {
+ puts stderr "Exec: $command"
+ }
+ if { $WATCHONLY } {
+ return [list 1 1]
+ }
+ if [catch {eval exec $command} status] {
+ puts stderr "Error in command: $command"
+ puts stderr "Status : $status"
+ return [list -1 $status]
+ } else {
+ return [list 1 $status]
+ }
+}
+#
+# tar
+# Examples:
+#
+# tarfromroot:
+#
+# wokUtils:EASY:tar tarfromroot /tmp/yan.tar .
+# wokUtils:EASY:tar tarfromroot [glob ./*.tcl]
+#
+# tarfromlist:
+#
+# wokUtils:EASY:tar tarfromliste /tmp/yan.tar /tmp/LISTE
+# (si LISTE = basenames => tous les fichiers dans le repertoire courant)
+# (si LISTE = fullpathes => ya des fulls path dans le tar)
+#
+# untar :
+#
+# wokUtils:EASY:tar untar /tmp/yan.tar
+#
+# untarZ :
+#
+# wokUtils:EASY:tar untarZ /tmp/yan.tarZ
+#
+proc wokUtils:EASY:tar { option args } {
+
+ catch { unset command return_output }
+
+ switch -- $option {
+
+ tarfromroot {
+ set name [lindex $args 0]
+ set root [lindex $args 1]
+ append command {tar cf } $name " " $root
+ }
+
+ tarfromliste {
+ set name [lindex $args 0]
+ set list [lindex $args 1]
+ if [file exists $list] {
+ set liste [wokUtils:FILES:FileToList [lindex $args 1]]
+ append command {tar cf } $name
+ foreach f $liste {
+ append command " " $f
+ }
+ } else {
+ error "File $list not found"
+ return -1
+ }
+ }
+
+ untar {
+ set name [lindex $args 0]
+ append command {tar xof } $name
+ }
+
+ untarZ {
+ set name [lindex $args 0]
+ append command uncompress { -c } $name { | tar xof - >& /dev/null }
+ }
+
+
+ ls {
+ set return_output 1
+ set name [lindex $args 0]
+ append command {tar tvf } $name
+ }
+
+ lsZ {
+ set return_output 1
+ set name [lindex $args 0]
+ append command uncompress { -c } $name { | tar tvf - }
+ }
+
+ }
+
+ ;#puts "command = $command"
+
+ if [catch {eval exec $command} status] {
+ puts stderr "Tar Error in command: $command"
+ puts stderr "Status : $status"
+ set statutar -1
+ } else {
+ if [info exist return_output] {
+ set statutar $status
+ } else {
+ set statutar 1
+ }
+ }
+
+ return $statutar
+}
+;#
+;# topological sort. returns a list.
+;#wokUtils:EASY:tsort { {a h} {b g} {c f} {c h} {d i} }
+;# => { d a b c i g f h }
+proc wokUtils:EASY:tsort { listofpairs } {
+ foreach x $listofpairs {
+ set e1 [lindex $x 0]
+ set e2 [lindex $x 1]
+ if ![info exists pcnt($e1)] {
+ set pcnt($e1) 0
+ }
+ if ![ info exists pcnt($e2)] {
+ set pcnt($e2) 1
+ } else {
+ incr pcnt($e2)
+ }
+ if ![info exists scnt($e1)] {
+ set scnt($e1) 1
+ } else {
+ incr scnt($e1)
+ }
+ set l {}
+ if [info exists slist($e1)] {
+ set l $slist($e1)
+ }
+ lappend l $e2
+ set slist($e1) $l
+ }
+ set nodecnt 0
+ set back 0
+ foreach node [array names pcnt] {
+ incr nodecnt
+ if { $pcnt($node) == 0 } {
+ incr back
+ set q($back) $node
+ }
+ if ![info exists scnt($node)] {
+ set scnt($node) 0
+ }
+ }
+ set res {}
+ for {set front 1} { $front <= $back } { incr front } {
+ lappend res [set node $q($front)]
+ for {set i 1} {$i <= $scnt($node) } { incr i } {
+ set ll $slist($node)
+ set j [expr {$i - 1}]
+ set u [expr { $pcnt([lindex $ll $j]) - 1 }]
+ if { [set pcnt([lindex $ll $j]) $u] == 0 } {
+ incr back
+ set q($back) [lindex $ll $j]
+ }
+ }
+ }
+ if { $back != $nodecnt } {
+ puts stderr "input contains a cycle"
+ return {}
+ } else {
+ return $res
+ }
+}
+#
+#
+#
+proc wokUtils:EASY:OneHead { str len } {
+ return $str[replicate " " [expr { $len - [string length $str] }]]
+}
+#
+# Sho call stack
+#
+proc wokUtils:EASY:ShowCall {{file stdout}} {
+ puts $file "Tcl call trace"
+ for { set l [expr [info level]-1] } { $l > 0 } { incr l -1 } {
+ puts $file "$l : [info level $l]"
+ }
+}
+
+;#
+;# search for each element in dfile if it belongs to a directory of dlist
+;#
+proc wokUtils:EASY:yfind { dfile dlist } {
+ set ret {}
+ foreach file $dfile {
+ set f {}
+ foreach dir $dlist {
+ if [file exists $dir/$file] {
+ set f $dir
+ break
+ }
+ }
+ lappend ret [list $file $f]
+ }
+ return $ret
+}
+;#
+;# returns the list of all directories under dir
+;#
+proc wokUtils:EASY:seadir { dir } {
+ set l $dir
+ foreach f [readdir $dir] {
+ if [file isdirectory $dir/$f] {
+ set l [concat $l [wokUtils:EASY:seadir $dir/$f]]
+ }
+ }
+ return $l
+}
+
+proc wokUtils:EASY:NiceList { a sep } {
+ set maxl 0
+ foreach x $a {
+ if { [set lc [string length [lindex $x 0]]] > $maxl } {
+ set maxl $lc
+ }
+ }
+ incr maxl ; set ret ""
+ foreach x $a {
+ set value [lindex $x 1]
+ if { [set name [lindex $x 0]] == "separator" } {
+ append ret \n
+ } else {
+ append ret [format "%-*s %s" $maxl $name$sep $value]\n
+ }
+ }
+ return $ret
+}
+
+proc wokUtils:FILES:html { file } {
+ global tcl_platform
+ if { "$tcl_platform(platform)" == "unix" } {
+ set cmd "exec netscape -remote \"openFile($file)\""
+ if { [catch $cmd] != 0 } {
+ exec netscape &
+ while { [catch $cmd] != 0 } {
+ after 500
+ }
+ }
+ } elseif { "$tcl_platform(platform)" == "windows" } {
+ set cmd [list exec netscape $file &]
+ if { [catch $cmd] != 0 } {
+ set prog [tk_getOpenFile -title "Where is Netscape ?"]
+ if { $prog != "" } {
+ puts $prog
+ exec $prog $file &
+ }
+ }
+ }
+ return
+}
+;# essais
+;#
+;#proc wokUtils:FILES:lcprp { listorig target } {
+;# foreach r $listorig {
+;# puts "Copying $r onto $target"
+;# catch { exec cp -rp $r $target} status
+;# puts "$status"
+;# }
+;#}
+
+;#proc wokUtils:FILES:cprp { d1 d2 } {
+;# set cmd "tar cf - . | ( cd $d2 ; tar xf - )"
+;# return
+;#}
projects / occt-wok.git / commitdiff