← Back to branch summary

~ubuntu-branches/ubuntu/wily/libpgjava/wily

« back to all changes in this revision

Viewing changes to src/pl/tcl/modules/pltcl_loadmod.in

  • Committer: Bazaar Package Importer
  • Author(s): Arnaud Vandyck
  • Date: 2005-04-21 14:25:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20050421142511-wibh5vc31fkrorx7
Tags: 7.4.7-3
Built with sources...

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/pl/tcl/modules/pltcl_loadmod.in
 
1
#! /bin/sh
 
2
# Start tclsh \
 
3
exec @TCLSH@ "$0" "$@"
 
4
 
 
5
#
 
6
# Code still has to be documented
 
7
#
 
8
 
 
9
#load /usr/local/pgsql/lib/libpgtcl.so
 
10
package require Pgtcl
 
11
 
 
12
 
 
13
#
 
14
# Check for minimum arguments
 
15
#
 
16
if {$argc < 2} {
 
17
    puts stderr ""
 
18
    puts stderr "usage: pltcl_loadmod dbname \[options\] file \[...\]"
 
19
    puts stderr ""
 
20
    puts stderr "options:"
 
21
    puts stderr "    -host hostname"
 
22
    puts stderr "    -port portnumber"
 
23
    puts stderr ""
 
24
    exit 1
 
25
}
 
26
 
 
27
#
 
28
# Remember database name and initialize options
 
29
#
 
30
set dbname [lindex $argv 0]
 
31
set options ""
 
32
set errors 0
 
33
set opt ""
 
34
set val ""
 
35
 
 
36
set i 1
 
37
while {$i < $argc} {
 
38
    if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} {
 
39
        break;
 
40
    }
 
41
 
 
42
    set opt [lindex $argv $i]
 
43
    incr i
 
44
    if {$i >= $argc} {
 
45
        puts stderr "no value given for option $opt"
 
46
        incr errors
 
47
        continue
 
48
    }
 
49
    set val [lindex $argv $i]
 
50
    incr i
 
51
 
 
52
    switch -- $opt {
 
53
        -host {
 
54
            append options "-host \"$val\" "
 
55
        }
 
56
        -port {
 
57
            append options "-port $val "
 
58
        }
 
59
        default {
 
60
            puts stderr "unknown option '$opt'"
 
61
            incr errors
 
62
        }
 
63
    }
 
64
}
 
65
 
 
66
#
 
67
# Final syntax check
 
68
#
 
69
if {$i >= $argc || $errors > 0} {
 
70
    puts stderr ""
 
71
    puts stderr "usage: pltcl_loadmod dbname \[options\] file \[...\]"
 
72
    puts stderr ""
 
73
    puts stderr "options:"
 
74
    puts stderr "    -host hostname"
 
75
    puts stderr "    -port portnumber"
 
76
    puts stderr ""
 
77
    exit 1
 
78
}
 
79
 
 
80
 
 
81
proc __PLTcl_loadmod_check_table {conn tabname expnames exptypes} {
 
82
    set attrs [expr [llength $expnames] - 1]
 
83
    set error 0
 
84
    set found 0
 
85
 
 
86
    pg_select $conn "select C.relname, A.attname, A.attnum, T.typname   \
 
87
                from pg_catalog.pg_class C, pg_catalog.pg_attribute A, pg_catalog.pg_type T             \
 
88
                where C.relname = '$tabname'                            \
 
89
                  and A.attrelid = C.oid                                \
 
90
                  and A.attnum > 0                                      \
 
91
                  and T.oid = A.atttypid                                \
 
92
                order by attnum" tup {
 
93
 
 
94
        incr found
 
95
        set i $tup(attnum)
 
96
 
 
97
        if {$i > $attrs} {
 
98
            puts stderr "Table $tabname has extra field '$tup(attname)'"
 
99
            incr error
 
100
            continue
 
101
        }
 
102
 
 
103
        set xname [lindex $expnames $i]
 
104
        set xtype [lindex $exptypes $i]
 
105
 
 
106
        if {[string compare $tup(attname) $xname] != 0} {
 
107
            puts stderr "Attribute $i of $tabname has wrong name"
 
108
            puts stderr "    got '$tup(attname)' expected '$xname'"
 
109
            incr error
 
110
        }
 
111
        if {[string compare $tup(typname) $xtype] != 0} {
 
112
            puts stderr "Attribute $i of $tabname has wrong type"
 
113
            puts stderr "    got '$tup(typname)' expected '$xtype'"
 
114
            incr error
 
115
        }
 
116
    }
 
117
 
 
118
    if {$found == 0} {
 
119
        return 0
 
120
    }
 
121
 
 
122
    if {$found < $attrs} {
 
123
        incr found
 
124
        set miss [lrange $expnames $found end]
 
125
        puts "Table $tabname doesn't have field(s) $miss"
 
126
        incr error
 
127
    }
 
128
 
 
129
    if {$error > 0} {
 
130
        return 2
 
131
    }
 
132
 
 
133
    return 1
 
134
}
 
135
 
 
136
 
 
137
proc __PLTcl_loadmod_check_tables {conn} {
 
138
    upvar #0    __PLTcl_loadmod_status  status
 
139
 
 
140
    set error 0
 
141
 
 
142
    set names {{} modname modseq modsrc}
 
143
    set types {{} name int2 text}
 
144
 
 
145
    switch [__PLTcl_loadmod_check_table $conn pltcl_modules $names $types] {
 
146
        0 {
 
147
            set status(create_table_modules) 1
 
148
        }
 
149
        1 {
 
150
            set status(create_table_modules) 0
 
151
        }
 
152
        2 {
 
153
            puts "Error(s) in table pltcl_modules"
 
154
            incr error
 
155
        }
 
156
    }
 
157
 
 
158
    set names {{} funcname modname}
 
159
    set types {{} name name}
 
160
 
 
161
    switch [__PLTcl_loadmod_check_table $conn pltcl_modfuncs $names $types] {
 
162
        0 {
 
163
            set status(create_table_modfuncs) 1
 
164
        }
 
165
        1 {
 
166
            set status(create_table_modfuncs) 0
 
167
        }
 
168
        2 {
 
169
            puts "Error(s) in table pltcl_modfuncs"
 
170
            incr error
 
171
        }
 
172
    }
 
173
 
 
174
    if {$status(create_table_modfuncs) && !$status(create_table_modules)} {
 
175
        puts stderr "Table pltcl_modfuncs doesn't exist but pltcl_modules does"
 
176
        puts stderr "Either both tables must be present or none."
 
177
        incr error
 
178
    }
 
179
 
 
180
    if {$status(create_table_modules) && !$status(create_table_modfuncs)} {
 
181
        puts stderr "Table pltcl_modules doesn't exist but pltcl_modfuncs does"
 
182
        puts stderr "Either both tables must be present or none."
 
183
        incr error
 
184
    }
 
185
 
 
186
    if {$error} {
 
187
        puts stderr ""
 
188
        puts stderr "Abort"
 
189
        exit 1
 
190
    }
 
191
 
 
192
    if {!$status(create_table_modules)} {
 
193
        __PLTcl_loadmod_read_current $conn
 
194
    }
 
195
}
 
196
 
 
197
 
 
198
proc __PLTcl_loadmod_read_current {conn} {
 
199
    upvar #0    __PLTcl_loadmod_status          status
 
200
    upvar #0    __PLTcl_loadmod_modsrc          modsrc
 
201
    upvar #0    __PLTcl_loadmod_funclist        funcs
 
202
    upvar #0    __PLTcl_loadmod_globlist        globs
 
203
 
 
204
    set errors 0
 
205
 
 
206
    set curmodlist ""
 
207
    pg_select $conn "select distinct modname from pltcl_modules" mtup {
 
208
        set mname $mtup(modname);
 
209
        lappend curmodlist $mname
 
210
    }
 
211
 
 
212
    foreach mname $curmodlist {
 
213
        set srctext ""
 
214
        pg_select $conn "select * from pltcl_modules            \
 
215
                where modname = '$mname'                        \
 
216
                order by modseq" tup {
 
217
            append srctext $tup(modsrc)
 
218
        }
 
219
 
 
220
        if {[catch {
 
221
                __PLTcl_loadmod_analyze                         \
 
222
                        "Current $mname"                        \
 
223
                        $mname                                  \
 
224
                        $srctext new_globals new_functions
 
225
            }]} {
 
226
            incr errors
 
227
        }
 
228
        set modsrc($mname) $srctext
 
229
        set funcs($mname) $new_functions
 
230
        set globs($mname) $new_globals
 
231
    }
 
232
 
 
233
    if {$errors} {
 
234
        puts stderr ""
 
235
        puts stderr "Abort"
 
236
        exit 1
 
237
    }
 
238
}
 
239
 
 
240
 
 
241
proc __PLTcl_loadmod_analyze {modinfo modname srctext v_globals v_functions} {
 
242
    upvar 1     $v_globals new_g
 
243
    upvar 1     $v_functions new_f
 
244
    upvar #0    __PLTcl_loadmod_allfuncs        allfuncs
 
245
    upvar #0    __PLTcl_loadmod_allglobs        allglobs
 
246
 
 
247
    set errors 0
 
248
 
 
249
    set old_g [info globals]
 
250
    set old_f [info procs]
 
251
    set new_g ""
 
252
    set new_f ""
 
253
 
 
254
    if {[catch {
 
255
            uplevel #0 "$srctext"
 
256
        } msg]} {
 
257
        puts "$modinfo: $msg"
 
258
        incr errors
 
259
    }
 
260
 
 
261
    set cur_g [info globals]
 
262
    set cur_f [info procs]
 
263
 
 
264
    foreach glob $cur_g {
 
265
        if {[lsearch -exact $old_g $glob] >= 0} {
 
266
            continue
 
267
        }
 
268
        if {[info exists allglobs($glob)]} {
 
269
            puts stderr "$modinfo: Global $glob previously used in module $allglobs($glob)"
 
270
            incr errors
 
271
        } else {
 
272
            set allglobs($glob) $modname
 
273
        }
 
274
        lappend new_g $glob
 
275
        uplevel #0 unset $glob
 
276
    }
 
277
    foreach func $cur_f {
 
278
        if {[lsearch -exact $old_f $func] >= 0} {
 
279
            continue
 
280
        }
 
281
        if {[info exists allfuncs($func)]} {
 
282
            puts stderr "$modinfo: Function $func previously defined in module $allfuncs($func)"
 
283
            incr errors
 
284
        } else {
 
285
            set allfuncs($func) $modname
 
286
        }
 
287
        lappend new_f $func
 
288
        rename $func {}
 
289
    }
 
290
 
 
291
    if {$errors} {
 
292
        return -code error
 
293
    }
 
294
    #puts "globs in $modname: $new_g"
 
295
    #puts "funcs in $modname: $new_f"
 
296
}
 
297
 
 
298
 
 
299
proc __PLTcl_loadmod_create_tables {conn} {
 
300
    upvar #0    __PLTcl_loadmod_status  status
 
301
 
 
302
    if {$status(create_table_modules)} {
 
303
        if {[catch {
 
304
                set res [pg_exec $conn                          \
 
305
                    "create table pltcl_modules (               \
 
306
                        modname name,                           \
 
307
                        modseq  int2,                           \
 
308
                        modsrc  text);"]
 
309
            } msg]} {
 
310
            puts stderr "Error creating table pltcl_modules"
 
311
            puts stderr "    $msg"
 
312
            exit 1
 
313
        }
 
314
        if {[catch {
 
315
                set res [pg_exec $conn                          \
 
316
                    "create index pltcl_modules_i               \
 
317
                        on pltcl_modules using btree            \
 
318
                        (modname name_ops);"]
 
319
            } msg]} {
 
320
            puts stderr "Error creating index pltcl_modules_i"
 
321
            puts stderr "    $msg"
 
322
            exit 1
 
323
        }
 
324
        puts "Table pltcl_modules created"
 
325
        pg_result $res -clear
 
326
    }
 
327
 
 
328
    if {$status(create_table_modfuncs)} {
 
329
        if {[catch {
 
330
                set res [pg_exec $conn                          \
 
331
                    "create table pltcl_modfuncs (              \
 
332
                        funcname name,                          \
 
333
                        modname  name);"]
 
334
            } msg]} {
 
335
            puts stderr "Error creating table pltcl_modfuncs"
 
336
            puts stderr "    $msg"
 
337
            exit 1
 
338
        }
 
339
        if {[catch {
 
340
                set res [pg_exec $conn                          \
 
341
                    "create index pltcl_modfuncs_i              \
 
342
                        on pltcl_modfuncs using hash            \
 
343
                        (funcname name_ops);"]
 
344
            } msg]} {
 
345
            puts stderr "Error creating index pltcl_modfuncs_i"
 
346
            puts stderr "    $msg"
 
347
            exit 1
 
348
        }
 
349
        puts "Table pltcl_modfuncs created"
 
350
        pg_result $res -clear
 
351
    }
 
352
}
 
353
 
 
354
 
 
355
proc __PLTcl_loadmod_read_new {conn} {
 
356
    upvar #0    __PLTcl_loadmod_status          status
 
357
    upvar #0    __PLTcl_loadmod_modsrc          modsrc
 
358
    upvar #0    __PLTcl_loadmod_funclist        funcs
 
359
    upvar #0    __PLTcl_loadmod_globlist        globs
 
360
    upvar #0    __PLTcl_loadmod_allfuncs        allfuncs
 
361
    upvar #0    __PLTcl_loadmod_allglobs        allglobs
 
362
    upvar #0    __PLTcl_loadmod_modlist         modlist
 
363
 
 
364
    set errors 0
 
365
 
 
366
    set new_modlist ""
 
367
    foreach modfile $modlist {
 
368
        set modname [file rootname [file tail $modfile]]
 
369
        if {[catch {
 
370
                set fid [open $modfile "r"]
 
371
            } msg]} {
 
372
            puts stderr $msg
 
373
            incr errors
 
374
            continue
 
375
        }
 
376
        set srctext [read $fid]
 
377
        close $fid
 
378
 
 
379
        if {[info exists modsrc($modname)]} {
 
380
            if {[string compare $modsrc($modname) $srctext] == 0} {
 
381
                puts "Module $modname unchanged - ignored"
 
382
                continue
 
383
            }
 
384
            foreach func $funcs($modname) {
 
385
                unset allfuncs($func)
 
386
            }
 
387
            foreach glob $globs($modname) {
 
388
                unset allglobs($glob)
 
389
            }
 
390
            unset funcs($modname)
 
391
            unset globs($modname)
 
392
            set modsrc($modname) $srctext
 
393
            lappend new_modlist $modname
 
394
        } else {
 
395
            set modsrc($modname) $srctext
 
396
            lappend new_modlist $modname
 
397
        }
 
398
 
 
399
        if {[catch {
 
400
                __PLTcl_loadmod_analyze "New/updated $modname"  \
 
401
                        $modname $srctext new_globals new_funcs
 
402
            }]} {
 
403
            incr errors
 
404
        }
 
405
 
 
406
        set funcs($modname) $new_funcs
 
407
        set globs($modname) $new_globals
 
408
    }
 
409
 
 
410
    if {$errors} {
 
411
        puts stderr ""
 
412
        puts stderr "Abort"
 
413
        exit 1
 
414
    }
 
415
 
 
416
    set modlist $new_modlist
 
417
}
 
418
 
 
419
 
 
420
proc __PLTcl_loadmod_load_modules {conn} {
 
421
    upvar #0    __PLTcl_loadmod_modsrc          modsrc
 
422
    upvar #0    __PLTcl_loadmod_funclist        funcs
 
423
    upvar #0    __PLTcl_loadmod_modlist         modlist
 
424
 
 
425
    set errors 0
 
426
 
 
427
    foreach modname $modlist {
 
428
        set xname [__PLTcl_loadmod_quote $modname]
 
429
 
 
430
        pg_result [pg_exec $conn "begin;"] -clear
 
431
 
 
432
        pg_result [pg_exec $conn                                \
 
433
                "delete from pltcl_modules where modname = '$xname'"] -clear
 
434
        pg_result [pg_exec $conn                                \
 
435
                "delete from pltcl_modfuncs where modname = '$xname'"] -clear
 
436
 
 
437
        foreach func $funcs($modname) {
 
438
            set xfunc [__PLTcl_loadmod_quote $func]
 
439
            pg_result [                                                 \
 
440
                pg_exec $conn "insert into pltcl_modfuncs values (      \
 
441
                        '$xfunc', '$xname')"                            \
 
442
            ] -clear
 
443
        }
 
444
        set i 0
 
445
        set srctext $modsrc($modname)
 
446
        while {[string compare $srctext ""] != 0} {
 
447
            set xpart [string range $srctext 0 3999]
 
448
            set xpart [__PLTcl_loadmod_quote $xpart]
 
449
            set srctext [string range $srctext 4000 end]
 
450
 
 
451
            pg_result [                                                 \
 
452
                pg_exec $conn "insert into pltcl_modules values (       \
 
453
                        '$xname', $i, '$xpart')"                        \
 
454
            ] -clear
 
455
            incr i
 
456
        }
 
457
 
 
458
        pg_result [pg_exec $conn "commit;"] -clear
 
459
 
 
460
        puts "Successfully loaded/updated module $modname"
 
461
    }
 
462
}
 
463
 
 
464
 
 
465
proc __PLTcl_loadmod_quote {s} {
 
466
    regsub -all {\\} $s {\\\\} s
 
467
    regsub -all {'}  $s {''} s
 
468
    return $s
 
469
}
 
470
 
 
471
 
 
472
set __PLTcl_loadmod_modlist [lrange $argv $i end]
 
473
set __PLTcl_loadmod_modsrc(dummy) ""
 
474
set __PLTcl_loadmod_funclist(dummy) ""
 
475
set __PLTcl_loadmod_globlist(dummy) ""
 
476
set __PLTcl_loadmod_allfuncs(dummy) ""
 
477
set __PLTcl_loadmod_allglobs(dummy) ""
 
478
 
 
479
unset __PLTcl_loadmod_modsrc(dummy)
 
480
unset __PLTcl_loadmod_funclist(dummy)
 
481
unset __PLTcl_loadmod_globlist(dummy)
 
482
unset __PLTcl_loadmod_allfuncs(dummy)
 
483
unset __PLTcl_loadmod_allglobs(dummy)
 
484
 
 
485
 
 
486
puts ""
 
487
 
 
488
set __PLTcl_loadmod_conn [eval pg_connect $dbname $options]
 
489
 
 
490
unset i dbname options errors opt val
 
491
 
 
492
__PLTcl_loadmod_check_tables $__PLTcl_loadmod_conn
 
493
 
 
494
__PLTcl_loadmod_read_new $__PLTcl_loadmod_conn
 
495
 
 
496
__PLTcl_loadmod_create_tables $__PLTcl_loadmod_conn
 
497
__PLTcl_loadmod_load_modules $__PLTcl_loadmod_conn
 
498
 
 
499
pg_disconnect $__PLTcl_loadmod_conn
 
500
 
 
501
puts ""