1#!%TCLSH%
2
3#
4# Handle link numbers
5#
6# Parameters (form or url): none
7#   - menu page with creation/reuse form and list
8#      - action: (none)
9#   - creation
10#      - action: "create"
11#      - descr: link description
12#   - reuse
13#      - action: "reuse"
14#      - id: link id
15#      - descr: link description
16#      - confirm: yes or no
17#   - edition
18#      - action: "edit"
19#      - id: link id
20#   - modification (after edit)
21#      - action: "mod"
22#      - id: link id
23#      - descr: link description
24#
25# History
26#   2012/01/21 : jean      : design
27#
28
29#
30# Template pages used by this script
31#
32
33set conf(page-init)		genl.html
34set conf(page-edit)		genl-edit.html
35set conf(page-ok)		genl-ok.html
36set conf(page-confirm)		genl-confirm.html
37
38#
39# Script name called in url
40#
41set conf(script)	"genl"
42
43# Format for link list display
44
45set conf(tablink) {
46    global {
47	    chars {10 normal}
48	    columns {15 70 15}
49	    botbar {no}
50	    align {left}
51    }
52    pattern Title {
53	    title {yes}
54	    chars {10 bold}
55	    vbar {no}
56	    column { }
57	    vbar {no}
58	    column {
59	    	multicolumn {2}
60	    }
61	    vbar {no}
62    }
63    pattern Normal {
64	    vbar {no}
65	    column { }
66	    vbar {no}
67	    column { }
68	    vbar {no}
69	    column { format {raw} }
70	    vbar {no}
71    }
72}
73
74#
75# Netmagis general library
76#
77
78source %LIBNETMAGIS%
79
80# ::webapp::cgidebug ; exit
81
82##############################################################################
83# Utility functions
84##############################################################################
85
86proc gen-link-list {l title modlink} {
87   global conf
88
89   set lines {}
90   if {$title} then {
91   	lappend lines [list "Title" \
92				[mc "Id"] \
93				[mc "Description"] \
94			]
95   }
96   foreach e $l {
97   	lassign $e id descr
98	set edit ""
99	if {$modlink} then {
100	    d urlset "" $conf(script) [list {action edit} [list id $id]]
101	    set edit [::webapp::helem "a" [mc "Edit"] "href" [d urlget ""]]
102	}
103	lappend lines [list "Normal" $id $descr $edit]
104    }
105
106    return [::arrgen::output "html" $conf(tablink) $lines]
107}
108
109proc check-idlink {dbfd id} {
110    if {! [regexp {^L?([0-9]+)$} $id dummy id]} then {
111	d error [format [mc "Invalid link number (%s)"] $id]
112    }
113
114    set sql "SELECT MAX(idlink) AS max FROM topo.link"
115    set max -1
116    pg_select $dbfd $sql tab {
117	set max $tab(max)
118    }
119    if {$id > $max} then {
120	d error [format [mc "Non-existent link number (%s)"] $id]
121    }
122
123    return $id
124}
125
126
127
128
129##############################################################################
130# Default page presenting the link creation form
131##############################################################################
132
133d cgi-register {action {}} {
134} {
135    global conf
136
137    #
138    # Build link list
139    #
140
141    set l {}
142
143    set sql "SELECT idlink, descr FROM topo.link
144    		WHERE descr <> ''
145    		ORDER BY idlink ASC"
146
147    pg_select $dbfd $sql tab {
148	lappend l [list $tab(idlink) $tab(descr)]
149    }
150
151    set list [gen-link-list $l false true]
152
153    #
154    # Output result
155    #
156
157    d urlset "" $conf(script) {}
158    d result $conf(page-init) [list \
159					[list %URLFORM% [d urlget ""]] \
160					[list %LIST% $list] \
161				]
162}
163
164
165##############################################################################
166# Create a new link
167##############################################################################
168
169d cgi-register {action create} {
170	{descr    1 1}
171} {
172    global conf
173
174    set id -1
175    set descr [string trim $descr]
176    set qdescr [::pgsql::quote $descr]
177    set sql "INSERT INTO topo.link (descr) VALUES ('$qdescr') RETURNING idlink"
178    pg_select $dbfd $sql tab {
179	set id $tab(idlink)
180    }
181
182    if {$id > 0} then {
183	d urlset "" $conf(script) {}
184	set list [gen-link-list [list [list $id $descr]] true true]
185	d result $conf(page-ok) [list \
186				    [list %LIST% $list] \
187				]
188    } else {
189	d error [mc "Error while generating a link number"]
190    }
191}
192
193##############################################################################
194# Edit a link description
195##############################################################################
196
197d cgi-register {action edit} {
198    {id    	1 1}
199} {
200    global conf
201
202    set id [check-idlink $dbfd $id]
203
204    set descr ""
205    set sql "SELECT descr FROM topo.link WHERE idlink=$id"
206    pg_select $dbfd $sql tab {
207    	set descr $tab(descr)
208    }
209
210    d urlset "" $conf(script) {}
211    set descr [::webapp::html-string $descr]
212    d result $conf(page-edit) [list \
213					[list %URLFORM% [d urlget ""]] \
214					[list %ID% $id] \
215					[list %DESCR% $descr] \
216				]
217}
218
219
220##############################################################################
221# Commit modification for a link description
222##############################################################################
223
224d cgi-register {action mod} {
225    {id    	1 1}
226    {descr	1 1}
227} {
228    global conf
229
230    set id [check-idlink $dbfd $id]
231
232    set found 0
233    set sql "SELECT idlink FROM topo.link WHERE idlink = $id"
234    pg_select $dbfd $sql tab {
235	set found 1
236    }
237
238    set qdescr [::pgsql::quote $descr]
239    if {$found} then {
240	set sql "UPDATE topo.link SET descr='$qdescr' WHERE idlink=$id"
241    } else {
242	set sql "INSERT INTO topo.link (idlink, descr) VALUES ($id, '$qdescr')"
243    }
244    if {! [::pgsql::execsql $dbfd $sql msg]} then {
245	d error [format [mc "Can't modify link %s (%s)"] $id $msg]
246    }
247
248    set list [gen-link-list [list [list $id $descr]] true true]
249    d result $conf(page-ok) [list \
250				[list %LIST% $list] \
251			    ]
252}
253
254##############################################################################
255# Reuse an old link number
256##############################################################################
257
258d cgi-register {action reuse} {
259    {id    	1 1}
260    {descr	1 1}
261    {confirm	1 1}
262} {
263    global conf
264
265    set id [check-idlink $dbfd $id]
266
267    set currentdescr ""
268    set sql "SELECT descr FROM topo.link WHERE idlink=$id"
269    set exist false
270    pg_select $dbfd $sql tab {
271	set exist true
272	set currentdescr $tab(descr)
273    }
274
275    set qdescr [::pgsql::quote $descr]
276    if {$exist} then {
277	if {$confirm ne "yes"} then {
278	    set oldval [gen-link-list [list [list $id $currentdescr]] true false]
279	    set newval [gen-link-list [list [list $id $descr]] true false]
280	    set pdescr [::webapp::post-string $descr]
281    	    d urlset "" $conf(script) {}
282	    d result $conf(page-confirm) [list \
283					    [list %URLFORM% [d urlget ""]] \
284					    [list %OLDVAL% $oldval] \
285					    [list %NEWVAL% $newval] \
286					    [list %ID% $id] \
287					    [list %DESCR% $pdescr] \
288					 ]
289	} else {
290	    set sql "UPDATE topo.link SET descr='$qdescr' WHERE idlink=$id"
291	}
292    } else {
293	set sql "INSERT INTO topo.link (idlink, descr) VALUES ($id, '$qdescr')"
294    }
295
296    if {$confirm eq "yes"} then {
297	if {! [::pgsql::execsql $dbfd $sql msg]} then {
298	    d error [format [mc "Can't reuse link %s (%s)"] $id $msg]
299	}
300
301	set list [gen-link-list [list [list $id $descr]] true true]
302	d result $conf(page-ok) [list [list %LIST% $list]]
303    }
304}
305
306##############################################################################
307# Main procedure
308##############################################################################
309
310d cgi-dispatch "topo" "topogenl"
311