From ae40b193aa169e7907b94a0a5df4fcdf410214c7 Mon Sep 17 00:00:00 2001 From: cas Date: Fri, 22 Oct 1999 18:05:40 +0000 Subject: [PATCH] Initial revision --- src/WOKTclLib/FILES | 145 ++++ src/WOKTclLib/WOKVC.tcl | 1499 ++++++++++++++++++++++++++++++++++++ src/WOKTclLib/p-ul.tcl | 1362 ++++++++++++++++++++++++++++++++ src/WOKTclLib/wcompare.tcl | 374 +++++++++ src/WOKTclLib/wnews.tcl | 902 ++++++++++++++++++++++ src/WOKTclLib/wokCOO.tcl | 945 +++++++++++++++++++++++ src/WOKTclLib/wokQUE.tcl | 451 +++++++++++ src/WOKTclLib/wokStuff.tcl | 359 +++++++++ src/WOKTclLib/woksh.el-wnt | 357 +++++++++ src/WOKTclLib/wstore.tcl | 1001 ++++++++++++++++++++++++ src/WOKTclLib/wutils.tcl | 1367 ++++++++++++++++++++++++++++++++ 11 files changed, 8762 insertions(+) create mode 100755 src/WOKTclLib/FILES create mode 100755 src/WOKTclLib/WOKVC.tcl create mode 100755 src/WOKTclLib/p-ul.tcl create mode 100755 src/WOKTclLib/wcompare.tcl create mode 100755 src/WOKTclLib/wnews.tcl create mode 100755 src/WOKTclLib/wokCOO.tcl create mode 100755 src/WOKTclLib/wokQUE.tcl create mode 100755 src/WOKTclLib/wokStuff.tcl create mode 100755 src/WOKTclLib/woksh.el-wnt create mode 100755 src/WOKTclLib/wstore.tcl create mode 100755 src/WOKTclLib/wutils.tcl diff --git a/src/WOKTclLib/FILES b/src/WOKTclLib/FILES new file mode 100755 index 0000000..4048737 --- /dev/null +++ b/src/WOKTclLib/FILES @@ -0,0 +1,145 @@ +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 diff --git a/src/WOKTclLib/WOKVC.tcl b/src/WOKTclLib/WOKVC.tcl new file mode 100755 index 0000000..fa4ad64 --- /dev/null +++ b/src/WOKTclLib/WOKVC.tcl @@ -0,0 +1,1499 @@ + +############################################################################# +# +# W I N T E G R E +# _______________ +# +############################################################################# +# +# Usage +# +proc wokIntegreUsage { } { + puts stderr { } + puts stderr { usage : wintegre [ ]} + puts stderr { } + puts stderr { 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 } + 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 +# 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 {} 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 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 ] [-v ] + wget [-f] [-ud ] ... + wget [-f] -r + + -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 +} diff --git a/src/WOKTclLib/p-ul.tcl b/src/WOKTclLib/p-ul.tcl new file mode 100755 index 0000000..c0b1e8f --- /dev/null +++ b/src/WOKTclLib/p-ul.tcl @@ -0,0 +1,1362 @@ +#======================================================================================================== +# p-put Version 3.02 beta (egu 17/07/98 ) +# ajout verification que les fichiers embarques ne sont pas protege en ecriture sous WNT +#======================================================================================================== + +# +# Usage +# +proc p-putUsage { } { + puts stdout {p-put Version 3.02 17/07/98} + puts stdout {Usage : p-put [-h] (this help)} + puts stdout {Usage : p-put [-web] (updating web site)} + puts stdout {Usage : p-put [...] -B -U
    } + #puts stdout { p-put [...] -B -U
      [-P ] } + puts stdout { p-put [...] -B -U
        [-P ] -L -C "comment" } + return +} + +proc p-put { args } { + global env + + set tblreq(-h) {} + set tblreq(-web) {} + set tblreq(-B) value_required:string + set tblreq(-U) value_required:string + set tblreq(-P) value_required:string + set tblreq(-L) value_required:string + set tblreq(-C) value_required:string + + set param {} + if { [putils:EASY:GETOPT param tabarg tblreq p-putUsage $args] == -1 } return + +#==================== OPTIONS SETTINGS ========================== + + if [info exists tabarg(-web)] { + update-web-data + return + } + + if [info exists tabarg(-h)] { + p-putUsage + return + } + + set param_length [llength $param] + + if { $param_length == 0 } { + puts stderr "Error : You must enter at least one configuration" + return error + } else { + set list_config {} + foreach config $param { + lappend list_config $config + } + } + + ### ABOUT UL ### + + set nbargx 0 + if [info exists tabarg(-B)] { + set SRC_BAG_PATH $tabarg(-B) + if ![file exists $SRC_BAG_PATH] { + puts stderr " Error : can not see $SRC_BAG_PATH" + return error + } + incr nbargx + } + + if [info exists tabarg(-U)] { + set SRC_BAG_DIR $tabarg(-U) + set SRC_DIR ${SRC_BAG_PATH}/${SRC_BAG_DIR} + if ![file exists ${SRC_DIR}] { + puts stderr " Error : can not see $SRC_BAG_DIR directory under $SRC_BAG_PATH" + return error + } + incr nbargx + } + + if [info exists tabarg(-P)] { + set PATCH $tabarg(-P) + set AUTONUM 0 + } else { + set PATCH {} + set AUTONUM 1 + } + + ### ABOUT PATCH ### + + set nbargy 0 + + if [info exists tabarg(-C)] { + set COMMENT $tabarg(-C) + incr nbargy + } + + + if [info exists tabarg(-L)] { + set LIST_FILE $tabarg(-L) + if ![file readable $LIST_FILE] { + puts stderr " Error : can not read $LIST_FILE" + return + } else { + set f [open $LIST_FILE r] + set PB 0 + while { [ gets $f line ] >= 0 } { + if ![catch { glob ${SRC_DIR}/${line} } ] { + foreach fich [glob ${SRC_DIR}/${line}] { + if ![file readable $fich] { + puts stderr " Error : can not read $fich" + set PB 1 + } + } + if { $env(WOKSTATION) == "wnt"} { + foreach fich [glob ${SRC_DIR}/${line}] { + if ![file writable $fich] { + puts stderr " Error : $fich not writable, problem will exist for next patch" + set PB 1 + } + } + } + } else { + puts stderr " Error : can not glob line ${SRC_DIR}/${line}" + set PB 1 + } + } + close $f + if { $PB == 1 } { + puts stderr " Procedure aborted " + return 0 + } + } + incr nbargy + } else { + foreach fich [recursive_glob ${SRC_DIR} *] { + if ![file readable $fich] { + puts stderr " Error : can not read $fich" + return + } + } + if { $env(WOKSTATION) == "wnt"} { + foreach fich [recursive_glob ${SRC_DIR} *] { + if ![file writable $fich] { + puts stderr " Error : $fich not writable, problem will exist for next patch" + return + } + } + } + } + + ### REFERENCE ### + + set ULBAG [wokparam -e %BAG_Home REFERENCE] + + ### LETS GO ### + + if [expr {$nbargx == 2 && $nbargy == 0}] { + if {[put-ul $SRC_BAG_PATH $SRC_BAG_DIR $ULBAG $list_config] == 1 } { return end } + return error + } + + if [expr { $nbargx == 2 && $nbargy == 2}] { + if {[put-patch $SRC_BAG_PATH $SRC_BAG_DIR $AUTONUM $PATCH $ULBAG $LIST_FILE $COMMENT $list_config] == 1 } { return end } + return error + } + +} + +##################### PUT-UL ###################################### + +proc put-ul { src_bag ul_name dest_dir config_list} { + + + if [file exists ${dest_dir}/${ul_name}.tar.gz] { + puts stderr "Error : ${ul_name}.tar.gz already exist in ${dest_dir}" + return 0 + } + + set savpwd [pwd] + cd ${src_bag}/${ul_name} + + puts stdout "Info : Creating ${dest_dir}/${ul_name}.tar" + + if { [putils:EASY:tar tarfromroot ${dest_dir}/${ul_name}.tar .] == -1 } { + puts stderr "Error while creating ${dest_dir}/{ul_name}.tar " + catch {unlink ${dest_dir}/${ul_name}.tar} + cd $savpwd + return 0 + } + + puts stdout "Info : Gziping ${dest_dir}/${ul_name}.tar" + + if { [putils:FILES:compress ${dest_dir}/${ul_name}.tar] == -1 } { + puts stderr "Error while creating ${dest_dir}/${ul_name}.tar.gz + catch {unlink ${dest_dir}/${ul_name}.tar} + catch {unlink ${dest_dir}/${ul_name}.tar.gz} + cd $savpwd + return 0 + } + + #### Construction du fichier de trace #### + puts stdout "Info : Creating trace file ${dest_dir}/TRC/${ul_name}.trc" + set trace [open ${dest_dir}/TRC/${ul_name}.trc w] + foreach fich [glob ${src_bag}/${ul_name}/*] { + puts $trace $fich + } + close $trace + + #### Inscription dans le(s) configul(s) #### + set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"] + foreach config $config_list { + set CONFIGUL ${dest_dir}/CONFIGUL.${config} + puts stdout " Updating $CONFIGUL" + set f [ open $CONFIGUL a+] + set s [format "%-18s %s" $ul_name $now] + puts $f $s + close $f + } + + ###fin + puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" + cd $savpwd + + + #### mise a jour des fichiers du web #### + update-web-data + + return 1 +} + + +# +##################### PUT-PATCH ###################################### +# + +proc put-patch { src_bag ul_name AUTONUM patch_name dest_bag lst_patch comment config_list} { + + set dest_dir $dest_bag/PATCH + + ### Pour la numerotation automatique ### + if { $AUTONUM} { + set level [conf_ul_level $ul_name [lindex $config_list 0] $dest_bag] + foreach config $config_list { + if ![ file exists ${dest_dir}/PATCHISTO.${config} ] { + puts stderr "Error autonum: File ${dest_dir}/PATCHISTO.${config} dont exist, you must create it" + return 0 + } + set new_level [conf_ul_level $ul_name $config $dest_bag] + if { $new_level != $level } { + puts stderr " Error autonum : different patch levels in different configul " + return 0 + } + } + + + if { $level == -1 } { + puts stderr " Error : can't calculate patch levels " + return 0 + } + incr level + set patch_name ${ul_name}_${level} + puts stdout "Info : patch auto numerotation = $level" + } + + ##### + + set savpwd [pwd] + cd ${src_bag}/${ul_name} + + if [file exists ${dest_dir}/${patch_name}.tar.gz ] { + puts stderr "Error : File ${dest_dir}/${patch_name}.tar.gz already exists. Nothing done" + cd $savpwd + return 0 + } + + puts stdout "Info : Creating ${dest_dir}/${patch_name}.tar" + +if { [putils:EASY:tar tarfromliste ${dest_dir}/${patch_name}.tar ${lst_patch}] == -1 } { + puts stderr "Error while creating ${dest_dir}/{patch_name}.tar " + catch {unlink ${dest_dir}/{patch_name}.tar } + cd $savpwd + return 0 + } + + puts stdout "Info : Gziping ${dest_dir}/${patch_name}.tar" + if { [putils:FILES:compress ${dest_dir}/${patch_name}.tar] == -1 } { + puts stderr "Error while creating ${dest_dir}/${patch_name}.tar.gz + catch {unlink ${dest_dir}/${patch_name}.tar} + catch {unlink ${dest_dir}/${patch_name}.tar.gz} + cd $savpwd + return 0 + } + + puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" + + #### Construction du fichier de trace #### + puts stdout "Info : Creating trace file ${dest_dir}/TRC/${patch_name}.trc" + set f [open $lst_patch r] + set trace [open ${dest_dir}/TRC/${patch_name}.trc w] + while { [ gets $f line ] >= 0 } { + foreach fich [glob ${src_bag}/${ul_name}/${line}] { + puts $trace $fich + } + } + close $f + close $trace + + #### Inscription dans le(s) patchisto(s) #### + + #set now [string range [fmtclock [getclock]] 0 18] + set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"] + set level [lindex [split ${patch_name} _] end] + set ul_name [lindex [split ${patch_name} _] 0] + foreach config $config_list { + set PATCHISTO "${dest_dir}/PATCHISTO.${config}" + puts stdout "Info : updating $PATCHISTO" + set f [open $PATCHISTO r+] + set indice 0 + while { [ gets $f line ] >= 0 } { + if [ ctype alnum [ lindex $line 0 ] ] { + set indice [ lindex $line 0 ] + } + } + incr indice + puts stdout "Info : $PATCHISTO patch indice = $indice" + close $f + set lpatch [putils:FILES:FileToList $PATCHISTO ] + set s [format "%-5s%-18s%3s %-5s %s" $indice $ul_name $level $now $comment] + lappend lpatch $s + putils:FILES:ListToFile $lpatch $PATCHISTO + } + + ###FIN + puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" + cd $savpwd + + #### mise a jour des fichiers du web #### + update-web-data + + return 1 +} + +#================================================================================= +proc conf_ul_level { ul_name config bag_path } { + + set CONFIGUL ${bag_path}/CONFIGUL.${config} + set PATCHISTO ${bag_path}/PATCH/PATCHISTO.${config} + + set level -1 + if [file exists ${CONFIGUL} ] { + set f [open $CONFIGUL r ] + while {[gets $f line] >= 0 } { + if [ctype alnum [ cindex [lindex $line 0] 0 ] ] { + if { [lindex $line 0] == $ul_name } { + set level 0 + } + } + } + close $f + } + + if [file exists ${PATCHISTO}] { + set f [open $PATCHISTO r] + while { [ gets $f line ] >= 0 } { + if [ ctype alnum [ lindex $line 0 ] ] { + if { [lindex $line 1] == $ul_name } { + set level [lindex $line 2] + } + } + } + close $f + } + return $level +} + +################################################# +proc update-web-data { } { + + global env + set PROCFTPPATH $env(FACTORYHOME)/MajWeb + puts -nonewline "=== Updating www data....." + + if { $env(WOKSTATION) == "wnt"} { + if [file exists $PROCFTPPATH/putdata.ftp] { + if [catch { eval exec ftp {-v -i -s:$PROCFTPPATH/putdata.ftp} } status] { + puts stderr $status + } else { + puts " done ===" + } + } else { + puts stdout "Info : Cant find $PROCFTPPATH/putdata.ftp" + } + } else { + if [file exists $PROCFTPPATH/putdata.com] { + if [catch { eval exec $PROCFTPPATH/putdata.com } status] { + puts stderr $status + } else { + puts " done ===" + } + } else { + puts stdout "Info : Cant find $PROCFTPPATH/putdat.ftp" + } + } +return +} + +#======================================================================================================== +# p-get Version 3.04 (egu 29/09/98 ) +# ajout de l'option -f pour forcer l'install des patch +# (ajout de l'option -runtime pour ne pas faire de declarations +# liees a la descente des patchs)activite non visible +# Modification de nombreuses functions pour wok: wok n'est plus versionne +# suppression des options -v (verbose) et -n (no execute) +#======================================================================================================== +#======================================================================================================== +#======================================================================================================== + +proc p-get-usage { } { + puts stderr {} + puts stdout {p-get Version 3.04 (september 98)} + #puts stderr {Usage : p-get [-h][-f][-rt][-clean][-d dirinstall] [del list] [-P patch |-I indice]} + puts stderr {Usage : p-get [-h][-f][-clean][-d dirinstall] [del list] [-P patch |-I indice]} + puts stderr { -h : this help} + puts stderr { -f : force install} +# puts stderr { -rt : runtime mode} #fonctionne mais volontairement cache + puts stderr { -clean : clean mode} + puts stderr { [-d dirinstall] : directory to install ul} + puts stderr { : configuration} + puts stderr { [del list] : list of one or more Delivery: [ [del2] [del3] ... ]} + puts stderr { OR "ALL" ("ALL" is default value)} + puts stderr { [-P patch | : patch number OR "ALL" ("ALL" is default value)} + puts stderr { |-I indice] : indice number OR "ALL" ("ALL" is default value)} +# puts stderr { Online doc at http://info.paris1.matra-dtv.fr/Devlog/Departements/Dcfao/env/pget304.htm} + return +} + +#======================================================================================================== + +proc p-get { args } { + + global env + + set tblreq(-h) {} + set tblreq(-f) {} + set tblreq(-rt) {} + set tblreq(-clean) {} + set tblreq(-d) value_required:string + set tblreq(-P) value_required:string + set tblreq(-I) value_required:string + + set param {} + if { [putils:EASY:GETOPT param tabarg tblreq p-get-usage $args] == -1 } return + set param_length [llength $param] + + #======================================= VARIABLES SETTINGS ============================================= + if [info exists tabarg(-h)] { + p-get-usage + return + } + + #----------- WOK SETTINGS ------------------------------------- + wokclose -a [wokparam -e %[finfo]_Home] + set SRCBAGPATH [wokparam -e %BAG_Home REFERENCE] + set SRCPATCHPATH $SRCBAGPATH/PATCH + set DESTBAGPATH [wokparam -e %BAG_Home] + + #------------- OPTIONS SETTINGS ------------------------------- + set FORCE [info exists tabarg(-f)] + set RUNTIME [info exists tabarg(-rt)] + set CLEAN [info exists tabarg(-clean)] + + if [info exists tabarg(-d)] { + set NEWDIR $tabarg(-d) + } else { + set NEWDIR 0 + } + + if { $param_length == 0 } { + puts stderr " Error : You must at least enter a configuration" + p-get-usage + return + } + + set CONF [lindex $param 0] + set CONFIGUL ${SRCBAGPATH}/CONFIGUL.${CONF} + if { ![file exists $CONFIGUL] } { + puts stderr " Error : Cannot find $CONFIGUL, maybe version $CONF don't exist " + p-get-usage + return + } + + set PATCHISTO ${SRCPATCHPATH}/PATCHISTO.${CONF} + + set ul_list {} + if { $param_length == 1 } { lappend ul_list ALL } + if { $param_length >= 2 } { + if { [lindex $param 1] == "ALL" } { + lappend ul_list ALL + } else { + for { set i 1 } { $i < $param_length } { incr i } { + lappend ul_list [lindex $param $i] + } + } + } + + if [info exists tabarg(-P)] { + set maxlevel $tabarg(-P) + if { $maxlevel != "ALL" && [ctype digit $maxlevel] == 0 } { + puts stderr " Error : -P option must be a number or \"ALL\"" + p-get-usage + return + } + } else { + set maxlevel ALL + } + + if [info exists tabarg(-I)] { + set maxindice $tabarg(-I) + if { $maxindice != "ALL" && [ctype digit $maxindice] == 0 } { + puts stderr " Error : -I option must be a number or \"ALL\"" + p-get-usage + return + } + } else { + set maxindice ALL + } + + + #----------- OPTIONS RESTRICTIONS -------------------------- + + if { $maxlevel != "ALL" && $maxindice != "ALL" } { + puts stderr "Error : You can't use -I and -P options together" + return + } + + if { $maxlevel != "ALL" } { + if { [llength $ul_list] > 1 || [lindex $ul_list 0] == "ALL"} { + puts stderr "Error : You can't use -P option with more than one selected UL" + return + } + } + + #-- Infos -- + puts "SELECTED UL(s) : $ul_list" + puts "CONFIGURATION : $CONF" + puts "MAX PATCH LEVEL : $maxlevel" + puts "MAX INDICE LEVEL : $maxindice" + if { $NEWDIR != 0 } { + puts "INSTALLATION DIR : $NEWDIR" + } else { + puts "INSTALLATION DIR : $DESTBAGPATH" + } + if $FORCE { puts "FORCE ON" } + if $RUNTIME { puts "RUNTIME ON" } + puts {} + + + #================================= LET'S GO ============================================== + #====== creating array mytab of couples (ul full name - patch level to be installed) ====== + + #reconstruct ul_list if "ALL" ul specified + if { [lindex $ul_list 0] == "ALL" } { + set admdir [wokparam -e %[finfo]_Adm] + set file ${admdir}/${CONF}.edl + if [file exists $file] { + wokclose -a [wokparam -e %[finfo]_Home] + set lst_conf [join [wokparam -e %${CONF}_Config] ] + if ![ catch { wokparam -e %${CONF}_Runtime } gonogo ] { + foreach a [join [wokparam -e %${CONF}_Runtime] ] { lappend lst_conf $a } + } + set ul_list {} + foreach p $lst_conf { + if { [lindex [split $p "-"] 1] != $CONF } { + puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p" + #return + } else { + lappend ul_list [lindex [split $p "-"] 0] + } + } + foreach p $lst_conf { + if { [lindex [split $p "-"] 1] != $CONF } { + puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p" + #return + } else { + lappend ul_list [lindex [split $p "-"] 0] + } + } + } else { + puts stderr "Error: None ul installed. Option ul_list = ALL can't be used" + return + } + } + + #construct array from CONFIGUL file + if { [array-set-from-CONFIGUL tab $CONFIGUL $ul_list] == 0 } { return } + + if { [array exists tab] == 0 } { + puts stderr "Error : none del of $CONF matching given list" + return + } + + #construct array from PATCHISTO file + array-set-from-PATCHISTO tab $PATCHISTO $ul_list $maxindice $maxlevel + + #----------- Infos ----------------- + puts "***** install levels *****" + array-print tab + + + #====================== Installation from array "tab" =============================== + + set lstul [ lsort [array names tab] ] + + ### set destination directory ### + if { $NEWDIR != 0 } { + foreach MYUL $lstul { + set MYDEL [lindex [split $MYUL "-"] 0] + set PARCELPATH [parcel-path $MYUL $CONF] + + #verrue wok + if { $MYDEL == "wok"} { + set pat ${DESTBAGPATH}/${MYUL} + if { $NEWDIR != $pat } { + puts stderr "Error : wok cannot be install in a special directory" + return + } + } + #fin verrue wok + + if { $PARCELPATH != 0 && $PARCELPATH != $NEWDIR } { + puts stderr "${MYDEL}-${CONF} already exist in $PARCELPATH : Cannot create same parcel in $NEWDIR" + puts stderr "Nothing done" + return + } + } + } + + ### begin install from array tab ### + foreach MYUL $lstul { + if { $tab($MYUL) >= 0 } { + set MYDEL [lindex [split $MYUL "-"] 0] + + ### test for wok + if { $MYDEL == "wok"} { + set MYPARCEL ${MYUL} + set PARCELPATH ${DESTBAGPATH}/${MYPARCEL} + } else { + set MYPARCEL ${MYDEL}-${CONF} + if { $NEWDIR != 0 } { + set PARCELPATH $NEWDIR + } else { + set PARCELPATH [parcel-path $MYUL $CONF] + if { $PARCELPATH == 0 } { + set PARCELPATH ${DESTBAGPATH}/${MYPARCEL} + } + } + } + + if $FORCE { + set level_to_begin_install 0 + } else { + set installed_level [parcel-level $MYUL $CONF] + set level_to_begin_install [expr ( $installed_level + 1)] + } + + if { $level_to_begin_install > $tab($MYUL) } { + set bag_patch_level [conf_ul_level $MYUL $CONF $SRCBAGPATH] +#FUN 13/10/98 + if {$installed_level > $tab($MYUL)} { + puts "\nWarning: $MYUL is already at level $installed_level > $tab($MYUL)" + } else { + puts "\n----- $MYUL is already at level $installed_level (max = $bag_patch_level)" + } + } else { + set s [format "\n----- INSTALLING %-15s\t%-3s>> %-3s in %s -----" $MYUL $level_to_begin_install $tab($MYUL) $PARCELPATH ] + puts stdout $s + } + + for { set pnumber $level_to_begin_install } { $pnumber <= $tab($MYUL) } { incr pnumber } { + puts stdout "INSTALL LEVEL $pnumber" + switch $pnumber 0 { + if { ![install-ul $MYUL $SRCBAGPATH $PARCELPATH $CONF taberror $RUNTIME $FORCE]} { break } + set pnumber [expr max(0,[parcel-level $MYUL $CONF])] + } default { + if { ![install-patch $MYUL $pnumber $SRCPATCHPATH $PARCELPATH $CONF taberror] } { break } + + } + } + + if $CLEAN { + set lst_station [join [wokparam -e %[finfo -W]_Stations] " "] + foreach station [join [wokparam -e %REFERENCE_Stations] " "] { + if {[lsearch -exact $lst_station $station] == -1} { + puts stdout " - removing $station dependent files..." + if { [file exists $PARCELPATH/$station] } { catch { exec rm -rf $PARCELPATH/$station } } + if { [file exists $PARCELPATH/tmp/$station] } { catch { exec rm -rf $PARCELPATH/tmp/$station } } + if { [file exists $PARCELPATH/.adm/$station] } { catch { exec rm -rf $PARCELPATH/.adm/$station } } + } + } + } + } + } + array-print taberror + + return +} + +#================================================================= +# ARRAY-SET-FROM-CONFIGUL (egu) +# +# set "array_name" with couples (ul-level) get from "conf-file". +# with ul matching "ul-list" element +#================================================================= + +proc array-set-from-CONFIGUL { array_name conf_file ul_list } { + + upvar $array_name tab + if [file readable $conf_file ] { + set f [open $conf_file r] + set line {} + while {[gets $f line] >= 0 } { + if { [llength $line] != 0 } { + if { [ctype alnum [cindex [lindex $line 0] 0]] == 1 } { + set ul_name [lindex $line 0] + if { [lindex $ul_list 0] == "ALL" } { + set tab($ul_name) 0 + } else { + foreach ul $ul_list { + if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } { + set tab($ul_name) 0 + break + } + } + } + } + } + } + close $f + } else { + puts stderr "Error : Can not read $conf_file" + return 0 + } + + return 1 +} + + +#================================================================= +# ARRAY-SET-FROM-PATCHISTO (egu) +# +# set "array_name" with couples (ul-level) get from "patch-file" +# line of indice < max_i +# with ul matching "ul-list" element +# with level < max_p +#================================================================= + +proc array-set-from-PATCHISTO { array_name patch_file ul_list {max_i ALL} {max_p ALL} } { + + upvar $array_name tab + if { $max_i == "ALL" } { set maxindice 1000000 } else { set maxindice $max_i } + if { $max_p == "ALL" } { set maxpatch 1000000 } else { set maxpatch $max_p } + if [ file readable $patch_file ] { + set f [open $patch_file r] + set line {} + incr maxindice + while { [ gets $f line ] >= 0 && [ lindex $line 0 ] != $maxindice } { + if { [ llength $line ] != 0 } { + if { [ ctype alnum [ lindex $line 0 ] ] == 1 } { + + set ul_name [lindex $line 1] + set ul_level [lindex $line 2] + if { [lindex $ul_list 0] == "ALL" } { + set tab($ul_name) $ul_level + } else { + foreach ul $ul_list { + if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } { + set tab($ul_name) [expr min($ul_level,$maxpatch)] + break + } + } + } + } + } + } + close $f + } else { + #puts stderr "Info : Can't find $patch_file, no patch exist for this configuration" + return 0 + } + return 1 +} + +#================================================================= +# ARRAY-PRINT (egu) +#================================================================= +proc array-print { array_name } { + upvar $array_name tab + set lst [lsort [array names tab]] + foreach elt $lst { + set s [format "%-20s\t%s" $elt $tab($elt)] + puts stdout $s + } +} + +#================================================================= +# PARCEL-EXIST (egu) +# test if parcel exist +# Last modif: 27/07/98: for wok (param del become param ul) +#================================================================= + +proc parcel-exist { ul conf } { + set del [lindex [split $ul "-"] 0] + #verrue wok + if { $del == "wok" } { + if [file exists [wokparam -e %BAG_Home]/${ul}] { + return 1 + } else { + return 0 + } + } + #fin verrue wok + set ul_name ${del}-${conf} + set lst [ Winfo -p [finfo]:[finfo -W]] + if {[lsearch -exact $lst $ul_name] == -1} { return 0 } else { return 1 } +} +#================================================================= +# PARCEL-PATH (egu) +# return parcel-path, 0 if it parcel doesn't exist +# Last modif: 27/07/98: for wok (param del become param ul) +#================================================================= + +proc parcel-path { ul conf } { + set del [lindex [split $ul "-"] 0] + if [parcel-exist $ul $conf] { + if { $del == "wok" } { + set path [wokparam -e %BAG_Home]/${ul} + } else { + set path [wokinfo -p HomeDir [finfo]:[finfo -W]:${del}-${conf}] + } + return $path + } else { + return 0 + } +} +#================================================================= +# PARCEL-LEVEL (egu) +# return the patch top level already install, -1 if no install +# Last modif: 27/07/98: for wok (param del become param ul) +#================================================================= + +proc parcel-level { ul conf } { + if [parcel-exist $ul $conf] { + set del [lindex [split $ul "-"] 0] + if { $del == "wok" } { + set getpatch_file [parcel-path $ul $conf]/.${ul}.GETPATCH + } else { + set getpatch_file [parcel-path $ul $conf]/.${del}-${conf}.GETPATCH + } + if [file exists $getpatch_file] { + set list_level [lsort -integer [p-get-installed $getpatch_file]] + set index [llength $list_level] + incr index -1 + return [lindex $list_level $index] + } else { + return 0 + } + } else { + return -1 + } +} + +#================================================================= +# INSTALL-UL (egu) +# +# create and declare parcel, return 0 if failled +# if success : return patch level already install +# 27/07/98: verrue for wok (egu) ajout option force et runtime +# 10/08/98: supression option vernose et no-execute +#================================================================= + +proc install-ul { ul_name src_dir dest_dir conf tab_error RUNTIME FORCE} { + + ### variables setting + upvar $tab_error tab_err + + #verrue anti verion pour wok + set MYDEL [lindex [split $ul_name "-"] 0] + if { $MYDEL == "wok" } { + set MYPARCEL ${ul_name} + } else { + set MYPARCEL ${MYDEL}-${conf} + } + set WAREHOUSE_ADM_PATH [wokparam -e %[finfo -W]_Adm] + set wdeclare_file ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl + set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH + set parcellist_file ${WAREHOUSE_ADM_PATH}/ParcelList + + ### on verifie l'existence du fichier a decompresser + set tar ${src_dir}/${ul_name}.tar.gz + if ![file exists $tar] { + puts stderr ".... error" + puts stderr "Nothing done : Cannot find $tar" + set tab_err($ul_name) "Nothing done : Cannot find $tar" + return 0 + } + + ### test cause option -d : dest_dir peut deja exister + if { ![file exists $dest_dir] } { + puts stdout " - Mkdir $dest_dir ..." + if [catch { mkdir $dest_dir} mkstat] { + puts stderr ".... error" + puts stderr "Nothing done : Cannot create $dest_dir : $mkstat" + set tab_err($ul_name) "Nothing done : Cannot create $dest_dir : $mkstat" + return 0 + } + } + + ### security cleaning + if [file exists $getpatch_file] { + puts stdout " - remove $getpatch_file" + exec rm -rf $getpatch_file + } + + ### let's go + puts stdout " - Downloading $tar in $dest_dir..." + p-get-ptar $ul_name $dest_dir $tar + + ### in FORCE case without first classic install + + if { $MYDEL != "wok" && $FORCE } { + if ![file exists [wokparam -e %[finfo -W]_Adm]/${MYPARCEL}.edl] { + set FORCE 0 + puts stdout " -> Info: ${MYPARCEL} has never been declared, it will in spite of FORCE option" + } + } + + # if: verrue for wok: pas de declaration + if { $MYDEL != "wok" && !$FORCE } { + if { [file exists ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl] } { + puts stderr ".... error" + puts stderr "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists" + set tab_err($ul_name) "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists" + return 0 + } else { + puts stdout " - Wdeclare ${MYPARCEL} (Don't worry about \"Error : No entity...\")" + puts stdout " -> Info: Wdeclare create $wdeclare_file and update $parcellist_file" + + if { [catch { Wdeclare -p $MYPARCEL -d -DHome=${dest_dir} -DStations=[join [wokparam -e %[finfo -W]_Stations] " "] -DDelivery=${MYDEL} [finfo -W] } ] } { + puts stderr ".... error" + puts stderr "Error Wdeclare $MYPARCEL" + set tab_err($ul_name) "Error Wdeclare $MYPARCEL" + return 0 + } + } + + #declaration + set FACTORY_ADM_PATH [wokparam -e %[finfo]_Adm] + puts stdout " - Updating ${FACTORY_ADM_PATH}/${conf}.edl file... " + if {[maj-conf-edl $conf $MYPARCEL $RUNTIME] == 0 } { + puts stderr ".... error" + puts stderr "Cannot update ${FACTORY_ADM_PATH}/${conf}.edl" + set tab_err($ul_name) "Error : Cannot update ${FACTORY_ADM_PATH}/${conf}.edl" + return 0 + } + } + return 1 +} +#================================================================= +# MAJ-CONF-EDL (egu) +# Mise a jour du fichier BAG/adm/${conf}.edl +# return 1 si ok, 0 sinon +#================================================================= + +proc maj-conf-edl { conf new_parcel RUNTIME } { + set admdir [wokparam -e %[finfo]_Adm] + set lst_conf {} + set lst_runt {} + if [file exists ${admdir}/${conf}.edl] { + wokclose -a [wokparam -e %[finfo]_Home] + set lst_conf [join [wokparam -e %${conf}_Config] ] + ### test cause old version of $file.edl + if ![ catch { wokparam -e %${conf}_Runtime } toto ] { + set lst_runt [join [wokparam -e %${conf}_Runtime] ] + } + exec rm -rf ${admdir}/${conf}.edl + } else { + #lappend lst_conf $new_parcel + } + if { $RUNTIME } { + lappend lst_runt $new_parcel + } else { + lappend lst_conf $new_parcel + } + return [make-conf-edl $conf $lst_conf $lst_runt ] +} +#================================================================= +# MAKE-CONF-EDL (egu) +#================================================================= + +proc make-conf-edl { conf lst_conf lst_runt } { + set admdir [wokparam -e %[finfo]_Adm] + set path ${admdir}/${conf}.edl + if [ catch { set fid [ open $path w ] } ] { + return 0 + } else { + puts $fid "@set %${conf}_Config = \"$lst_conf\"; " + puts $fid "@set %${conf}_Runtime = \"$lst_runt\"; " + close $fid + wokclose -a [wokparam -e %[finfo]_Home] + return 1 + } +} +#================================================================= +# INSTALL-PATCH (egu) +#================================================================= + +proc install-patch { ul_name patch_level src_dir dest_dir conf tab_error} { + upvar $tab_error tab_err + set tar ${src_dir}/${ul_name}_${patch_level}.tar.gz + if ![catch { file exists $tar } ] { + set MYDEL [lindex [split $ul_name "-"] 0] + if { $MYDEL == "wok" } { + set MYPARCEL ${ul_name} + } else { + set MYPARCEL ${MYDEL}-${conf} + } + + #untar + puts stdout " - Downloading $tar in $dest_dir... " + p-get-ptar ${ul_name}_${patch_level} $dest_dir $tar + + # updating .GETPATCH file + set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH + puts stdout " - Updating $getpatch_file file..." + set now [string range [fmtclock [getclock]] 0 18] + if [file exists $getpatch_file] { + set lf [putils:FILES:FileToList $getpatch_file] + } else { + set lf {} + } + set s [format "%s %s %s %s" $ul_name ${ul_name}_${patch_level} $dest_dir $now] + lappend lf $s + putils:FILES:ListToFile $lf $getpatch_file + + + } else { + puts stderr ".... error" + puts stderr "Nothing done : Cannot find $tar" + set tab_err(${ul_name}_${patch_level}) "Nothing done : Cannot find $tar" + return 0 + } + return 1 +} + +#================================================================= +# P-GET-INSTALLED (egu) +# +# return list of patch'numbers already write in GETPATCH file +# return null list if file doesn't exist +#================================================================= + +proc p-get-installed { file } { + if { ![file exists $file] } { + return {} + } else { + set ll {} + foreach l [putils:FILES:FileToList $file] { + lappend ll [lindex [split [lindex $l 1] _] end] + } + return $ll + } +} + +###============================================================================================== + +proc p-get-ptar { MYUL ULBAG tar } { + + global tcl_platform + set savpwd [pwd] + cd $ULBAG + + if { "$tcl_platform(platform)" == "unix" } { + + putils:EASY:tar untarZ ${tar} + + } elseif { "$tcl_platform(platform)" == "windows" } { + set dirtmp [putils:EASY:tmpname ulget[id process]] + catch { mkdir $dirtmp } + putils:FILES:copy ${tar} $dirtmp/${MYUL}.tar.gz + + if { [file exists $dirtmp/${MYUL}.tar] } { + unlink $dirtmp/${MYUL}.tar + } + putils:FILES:uncompress $dirtmp/${MYUL}.tar.gz + if { [file exists $dirtmp/${MYUL}.tar] } { + puts stderr "Info : Downloading $tar in [pwd]... " + putils:EASY:tar untar $dirtmp/${MYUL}.tar + } + unlink $dirtmp/${MYUL}.tar + unlink -nocomplain $dirtmp + } + cd $savpwd + return +} + +# +# ###################################################################### +# +proc putils: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 + } + } + } + + 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 + } + } + + } + + } + } + + return +} +# +# +# +proc putils: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 [putils:FILES:FileToList [lindex $args 1]] + append command {tar cf } $name + foreach f $liste { +#fsa + set listeeval [eval glob $f] + foreach ff $listeeval { + append command " " $ff + } +#fsa append command " " $f + } + } else { + error "File $list not found" + return -1 + } + } + + untar { + set name [lindex $args 0] + append command {tar xomf } $name + } + + untarZ { + set name [lindex $args 0] +#fun append command uncompress { -c } $name { | tar xof - >& /dev/null } + append command gzip { -d -c } $name { | tar xomf - >& /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] +#fun append command uncompress { -c } $name { | tar tvf - } + append command gzip -d { -c } $name { | tar tvf - } + } + + } + + ;#puts "command = $command" + + if [catch {eval exec $command} status] { + puts stderr "Tar messages 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 +} +# +# +# +proc putils:FILES:ListToFile { liste path } { + if [ catch { set id [ open $path w ] } ] { + return 0 + } else { + foreach e $liste { + puts $id $e + } + close $id + return 1 + } +} +# +# +# +proc putils: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 {} + } +} +# +# +# +proc putils: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 + } +} +# +# +## +proc putils:FILES:compress { fullpath } { + if [file exists ${fullpath}.gz] { + catch {unlink ${fullpath}.gz} + } +#fsa if [catch { exec compress -f $fullpath} status] + if [catch { exec gzip -f $fullpath} status] { + puts stderr "Error while compressing ${fullpath}: $status" + return -1 + } else { + return 1 + } +} + +proc putils:FILES:uncompress { fullpath } { +#fsa if [catch {exec uncompress -f $fullpath} status] +#fun:patch K4B_7 + if [catch {exec gzip -d -f $fullpath} status] { + puts stderr "Error while uncompressing ${fullpath}: $status" + return -1 + } else { + return 1 + } +} + +proc putils:EASY:tmpname { name } { + global env + global tcl_platform + if { "$tcl_platform(platform)" == "unix" } { + if [info exists env(TMPDIR)] { + return [file join $env(TMPDIR) $name] + } else { + return [file join "/tmp" $name] + } + } elseif { "$tcl_platform(platform)" == "windows" } { + return [file join $env(TMP) $name] + } + return {} +} + + diff --git a/src/WOKTclLib/wcompare.tcl b/src/WOKTclLib/wcompare.tcl new file mode 100755 index 0000000..b788a55 --- /dev/null +++ b/src/WOKTclLib/wcompare.tcl @@ -0,0 +1,374 @@ +;# 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 + } +} diff --git a/src/WOKTclLib/wnews.tcl b/src/WOKTclLib/wnews.tcl new file mode 100755 index 0000000..4d36c1e --- /dev/null +++ b/src/WOKTclLib/wnews.tcl @@ -0,0 +1,902 @@ +############################################################################# +# +# 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 redirect output in file. This option is ignored if -command is specified.} + puts stderr { -ws uses journal of instead of the current one. 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 } +# 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 +#;< +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 a +#;< +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 == ||LAST ( la marque posee le plus recemment ) +# s2 == ||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 {} + } + } + + } +} +;############################################################# diff --git a/src/WOKTclLib/wokCOO.tcl b/src/WOKTclLib/wokCOO.tcl new file mode 100755 index 0000000..07249de --- /dev/null +++ b/src/WOKTclLib/wokCOO.tcl @@ -0,0 +1,945 @@ +;# +;# 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) { + wokGetDoublon %W + } + + bind $IWOK_WINDOWS($w,hlist) { + 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) { + 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] { + wokPreparInitPere [winfo toplevel %W] [%W get] + update + } + + bind [$w.wbs.rev subwidget entry] { + wokPreparInitFils [winfo toplevel %W] [%W get] + update + } + + ;#bind $w { 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 +} diff --git a/src/WOKTclLib/wokQUE.tcl b/src/WOKTclLib/wokQUE.tcl new file mode 100755 index 0000000..0e5f72b --- /dev/null +++ b/src/WOKTclLib/wokQUE.tcl @@ -0,0 +1,451 @@ +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 { 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 +} diff --git a/src/WOKTclLib/wokStuff.tcl b/src/WOKTclLib/wokStuff.tcl new file mode 100755 index 0000000..fddb05b --- /dev/null +++ b/src/WOKTclLib/wokStuff.tcl @@ -0,0 +1,359 @@ +# +# +# +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 "$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 "$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 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] + +} diff --git a/src/WOKTclLib/woksh.el-wnt b/src/WOKTclLib/woksh.el-wnt new file mode 100755 index 0000000..6328e9c --- /dev/null +++ b/src/WOKTclLib/woksh.el-wnt @@ -0,0 +1,357 @@ +;;; 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" + "*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))) + + +;;(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))))))) + + +;; 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) +) diff --git a/src/WOKTclLib/wstore.tcl b/src/WOKTclLib/wstore.tcl new file mode 100755 index 0000000..40e1f1e --- /dev/null +++ b/src/WOKTclLib/wstore.tcl @@ -0,0 +1,1001 @@ + +############################################################################# +# +# 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 . + wstore [-ls] : Lists pending reports with their owner and IDs. + wstore -cat : Shows the content of . + wstore [-f] -rm : Remove a report from the queue + : (-f used to force if you dont own the report). + + Backup/Admin options: + -ctar : Create a tar file named with all reports in queue. + -xtar : Add all reports from tar file . + Add -v option to display informational messages + + -dump : 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_. +#;< +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 {} + } +} diff --git a/src/WOKTclLib/wutils.tcl b/src/WOKTclLib/wutils.tcl new file mode 100755 index 0000000..ea99e08 --- /dev/null +++ b/src/WOKTclLib/wutils.tcl @@ -0,0 +1,1367 @@ +# +# 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 i.e. with the following rules: +# If a line has format: 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 +;#} -- 2.39.5