1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
#########################################################################
# COPYRIGHT (C) 2003 EDF R&D WWW.CODE-ASTER.ORG #
# #
# THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR #
# MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS #
# PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE #
# LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. #
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, #
# BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF #
# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU #
# GENERAL PUBLIC LICENSE FOR MORE DETAILS. #
# #
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE #
# ALONG WITH THIS PROGRAM; IF NOT, WRITE TO : EDF R&D CODE_ASTER, #
# 1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE. #
#########################################################################
# $Id: ihm_rex.tcl 3577 2008-10-24 12:03:28Z courtois $
# choix d'un item du menu rex
#################################################################
proc choix_rex { ssongl } {
global rex_liste
switch -exact -- $ssongl {
rex { }
emis_sans {
# emission d'une fiche sans prendre en compte le profil
if { [rex_verif_identite] } {
rex_saisie_fiche 0
}
}
emis_prof {
# emission d'une fiche avec export du profil et rcupration des fichiers
if { [rex_verif_identite 1] } {
rex_saisie_fiche 1
}
}
consult {
# adresse du REX
if { $astk::agla(rex_url) == "" } {
set msg [ashare::mess info 42]
tk_messageBox -message $msg -type ok -icon info
change_status $msg
}
ashare::file_open_url $astk::agla(rex_url)
}
default {
ashare::mess erreur 5 $ssongl
}
}
}
# verifie que l'identit a t renseigne
# retourne 1 si ok, 0 sinon
#################################################################
proc rex_verif_identite { {fich_asso 0} } {
if { $astk::config(-1,nom_user) == "" || [regexp {Firstname} $astk::config(-1,nom_user)]
|| $astk::config(-1,email) == "" || $astk::config(-1,email) == "address@mail.com" } {
tk_messageBox -message [ashare::mess ihm 248] -type ok -icon info
return 0
}
if { $fich_asso == 1 } {
if { $astk::profil(surcharge) == "oui" } {
tk_messageBox -message [ashare::mess ihm 299] -type ok -icon error
return 0
}
}
return 1
}
# saisie d'une fiche (fich_asso=1 si fichiers associs, 0 sinon)
#################################################################
proc rex_saisie_fiche { fich_asso } {
global rex_ftype rex_fcmde bid_typfic
set fen .fen_rex_fiche
catch {destroy $fen}
toplevel $fen
wm withdraw $fen
wm title $fen "[ashare::mess ihm 11]"
wm transient $fen .
# fiche
pack [frame $fen.f -relief flat -bd 0] -fill x -padx 5 -pady 5
# entete
label $fen.f.em -font $astk::ihm(font,labbout) -text [ashare::mess ihm 216] -anchor w
pack $fen.f.em -fill x -expand yes
pack [frame $fen.f.f1a -relief flat -bd 0] -anchor w -padx 5
label $fen.f.f1a.lab -font $astk::ihm(font,lab) -text "[ashare::mess ihm 89]*" -width 30 -anchor w
label $fen.f.f1a.val -font $astk::ihm(font,lab) -text $astk::config(-1,nom_user)
pack $fen.f.f1a.lab $fen.f.f1a.val -side left -padx 10
pack [frame $fen.f.f1b -relief flat -bd 0] -anchor w -padx 5
label $fen.f.f1b.lab -font $astk::ihm(font,lab) -text "[ashare::mess ihm 90]*" -width 30 -anchor w
label $fen.f.f1b.val -font $astk::ihm(font,lab) -text $astk::config(-1,email)
pack $fen.f.f1b.lab $fen.f.f1b.val -side left -padx 10
if { $astk::config(-1,org) == "" } {
set astk::config(-1,org) [ashare::mess ihm 239]
}
pack [frame $fen.f.f1f -relief flat -bd 0] -anchor w -padx 5
label $fen.f.f1f.lab -font $astk::ihm(font,lab) -text "[ashare::mess ihm 240]*" -width 30 -anchor w
label $fen.f.f1f.val -font $astk::ihm(font,lab) -text $astk::config(-1,org)
pack $fen.f.f1f.lab $fen.f.f1f.val -side left -padx 10
label $fen.f.mod -font $astk::ihm(font,labpt) -text "(*) [ashare::mess ihm 235]"
pack $fen.f.mod -anchor w -padx 45
# paramtres
label $fen.f.pa -font $astk::ihm(font,labbout) -text [ashare::mess ihm 221] -anchor w
pack $fen.f.pa -fill x -expand yes
pack [frame $fen.f.f1c -relief flat -bd 0] -anchor w -padx 5
# type de fiche
label $fen.f.f1c.lab -font $astk::ihm(font,lab) -text [ashare::mess ihm 217] -width 30 -anchor w
set ltyp {218 219 236 237 220 238}
set labb {AL EL AO EO AOM ED}
set nb [llength $ltyp]
set rex_ftype ""
set lab [ashare::mess ihm 227]
set bid_typfic $lab
set MenuCor [tk_optionMenu $fen.f.f1c.val bid_typfic $lab]
$MenuCor configure \
-foreground $astk::ihm(couleur,menu_foreground) \
-background $astk::ihm(couleur,menu_background)
$MenuCor entryconfigure 0 -font $astk::ihm(font,labmenu) -command {set rex_ftype ""}
for {set j 0} {$j < $nb} {incr j} {
set lab [ashare::mess ihm [lindex $ltyp $j]]
$MenuCor add radiobutton
$MenuCor entryconfigure [expr $j+1] -label $lab -font $astk::ihm(font,labmenu) -variable bid_typfic -command "set rex_ftype [lindex $labb $j]"
}
pack $fen.f.f1c.lab $fen.f.f1c.val -side left -padx 10 -pady 1
set rex_fcmde ""
pack [frame $fen.f.f1d -relief flat -bd 0] -anchor w -padx 5
label $fen.f.f1d.lab -font $astk::ihm(font,lab) -text [ashare::mess ihm 222] -width 30 -anchor w
entry $fen.f.f1d.val -font $astk::ihm(font,lab) -textvariable rex_fcmde -width 55
pack $fen.f.f1d.lab $fen.f.f1d.val -side left -padx 10 -pady 1
pack [frame $fen.f.f1h -relief flat -bd 0] -anchor w -padx 5
label $fen.f.f1h.lab -font $astk::ihm(font,lab) -text [ashare::mess ihm 46] -width 30 -anchor w
label $fen.f.f1h.val -font $astk::ihm(font,lab) -text $astk::profil(version)
pack $fen.f.f1h.lab $fen.f.f1h.val -side left -padx 10 -pady 1
# fichiers associs
pack [frame $fen.f.f1e -relief flat -bd 0] -anchor w -padx 5
if { $fich_asso } {
append val [ashare::mess ihm 224]
} else {
append val [ashare::mess ihm 225]
}
label $fen.f.f1e.lab -font $astk::ihm(font,lab) -text [ashare::mess ihm 223] -width 30 -anchor w
label $fen.f.f1e.val -font $astk::ihm(font,lab) -text $val
pack $fen.f.f1e.lab $fen.f.f1e.val -side left -padx 10 -pady 1
# texte
pack [frame $fen.f2 -relief flat -bd 0] -fill both -expand yes -padx 5 -pady 5
text $fen.f2.tx -xscrollcommand "$fen.f2.scrollx set" -yscrollcommand "$fen.f2.scrolly set" \
-height 20 -width 80 -font $astk::ihm(font,zonfix) -bg $astk::ihm(couleur,entry_background) -wrap word
scrollbar $fen.f2.scrolly -command "$fen.f2.tx yview"
scrollbar $fen.f2.scrollx -command "$fen.f2.tx xview" -orient h
pack $fen.f2.scrolly -side right -fill y
pack $fen.f2.scrollx -side bottom -fill x
pack $fen.f2.tx -expand 1 -fill both
# ok / annuler
pack [frame $fen.valid -relief solid -bd 0] -pady 15
button $fen.valid.annuler -font $astk::ihm(font,labbout) -text [ashare::mess ihm 85] \
-command "destroy $fen" -bg $astk::ihm(couleur,annul)
button $fen.valid.ok -font $astk::ihm(font,labbout) -text [ashare::mess ihm 215] \
-command "rex_envoi $fen $fich_asso" -bg $astk::ihm(couleur,valid)
pack $fen.valid.ok $fen.valid.annuler -side left -padx 10 -pady 5
wm deiconify $fen
}
# envoi de la fiche
# parent : fenetre parent
# fich_asso=1 si fichiers associs, 0 sinon
#################################################################
proc rex_envoi { parent fich_asso } {
global rex_ftype rex_fcmde
# phase de vrification
if { $rex_ftype == "" } {
set msg [ashare::mess ihm 228]
change_status $msg
tk_messageBox -message $msg -type ok -icon info -parent $parent
return
}
set fexp [get_tmpname .file_rex_export]
# l'extension est obligatoire au moment de l'export
append fexp ".export"
set serv $astk::agla(num_serv)
if { $fich_asso } {
set astk::profil(special) ""
# on force la slection du serveur AGLA pour l'export
adapt_satellite 2
set iret [exporter astk_serv -1 $fexp "verif" "oui"]
adapt_satellite 0
if { $iret != 0 } {
set msg [ashare::mess erreur 40]
change_status $msg
tk_messageBox -message $msg -type ok -icon info -parent $parent
return
}
} else {
set idexp [open $fexp w]
write_server_infos $idexp $serv
close $idexp
}
set frex [get_tmpname .file_rex_fiche]
set idrex [open $frex w]
puts $idrex "@NOMUSER@"
regsub -all " " $astk::config(-1,nom_user) "\." tmp
puts $idrex $tmp
puts $idrex "@FINNOMUSER@"
puts $idrex "@MAILUSER@"
puts $idrex "$astk::config(-1,email)"
puts $idrex "@FINMAILUSER@"
puts $idrex "@UNIUSER@"
regsub -all " " $astk::config(-1,org) "\." tmp
puts $idrex $tmp
puts $idrex "@FINUNIUSER@"
puts $idrex "@TITRE@"
puts $idrex "$rex_fcmde"
puts $idrex "@FINTITRE@"
puts $idrex "@DATE1@"
puts $idrex [clock format [clock seconds] -format "%d/%m/%Y"]
puts $idrex "@FINDATE1@"
puts $idrex "@VERSION@"
puts $idrex "$astk::profil(version)"
puts $idrex "@FINVERSION@"
puts $idrex "@TYPFIC@"
puts $idrex "$rex_ftype"
puts $idrex "@FINTYPFIC@"
puts $idrex "@TEXTE@"
puts $idrex [$parent.f2.tx get 1.0 end]
puts $idrex "@FINTEXTE@"
if { $fich_asso } {
puts $idrex "@FICASS@"
puts $idrex "F"
puts $idrex "@FINFICASS@"
}
close $idrex
# prparation de la ligne de commande excuter
set lcmd ""
set argu ""
append lcmd [file join $ashare::prefix "usr/bin" as_run]
append lcmd " --proxy --create_issue --schema=[get_schema $serv create_issue]"
append lcmd [ashare::get_glob_args]
append argu $frex
append argu " "
append argu $fexp
# execution
set iret [ ashare::rexec_cmd -1 astk::config $lcmd $argu 0 out $parent progress]
if { $iret == 0 } {
if { [regexp {INDEX[ ]*=[ ]*([0-9]+)} $out mat1 index] } {
set msg [ashare::mess ihm 226 $index]
change_status $msg
} else {
ashare::mess "erreur" 3 "as_rex_creer" 99 $out
}
} else {
ashare::mess "erreur" 3 "as_rex_creer" $iret $out
set msg [ashare::mess ihm 60 $iret]
change_status $msg
tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok -icon info -parent $parent
}
# ferme la fenetre d'emission
destroy $parent
}
|
