← Back to branch summary

~vcs-imports/mammoth-replicator/trunk

« back to all changes in this revision

Viewing changes to src/pl/tcl/test/test_setup.sql

  • Committer: alvherre
  • Date: 2005-12-16 21:24:52 UTC
  • Revision ID: svn-v4:db760fc0-0f08-0410-9d63-cc6633f64896:trunk:1
Initial import of the REL8_0_3 sources from the Pgsql CVS repository.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/pl/tcl/test/test_setup.sql
 
1
--
 
2
-- checkpoint so that if we have a crash in the tests, replay of the
 
3
-- just-completed CREATE DATABASE won't discard the core dump file
 
4
--
 
5
checkpoint;
 
6
 
 
7
--
 
8
-- Create the tables used in the test queries
 
9
--
 
10
-- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1
 
11
-- Cannot be changed or deleted if they are referenced from T_dta1.
 
12
--
 
13
-- T_pkey2 is the primary key table for T_dta2. If the key values in
 
14
-- T_pkey2 are changed, the references in T_dta2 follow. If entries
 
15
-- are deleted, the referencing entries from T_dta2 are deleted too.
 
16
-- The values for field key2 in T_pkey2 are silently converted to
 
17
-- upper case on insert/update.
 
18
--
 
19
create table T_pkey1 (
 
20
    key1        int4,
 
21
    key2        char(20),
 
22
    txt         char(40)
 
23
);
 
24
 
 
25
create table T_pkey2 (
 
26
    key1        int4,
 
27
    key2        char(20),
 
28
    txt         char(40)
 
29
);
 
30
 
 
31
create table T_dta1 (
 
32
    tkey        char(10),
 
33
    ref1        int4,
 
34
    ref2        char(20)
 
35
);
 
36
 
 
37
create table T_dta2 (
 
38
    tkey        char(10),
 
39
    ref1        int4,
 
40
    ref2        char(20)
 
41
);
 
42
 
 
43
 
 
44
--
 
45
-- Function to check key existance in T_pkey1
 
46
--
 
47
create function check_pkey1_exists(int4, bpchar) returns bool as '
 
48
    if {![info exists GD]} {
 
49
        set GD(plan) [spi_prepare                               \\
 
50
            "select 1 from T_pkey1                              \\
 
51
                where key1 = \\$1 and key2 = \\$2"              \\
 
52
            {int4 bpchar}]
 
53
    }
 
54
    
 
55
    set n [spi_execp -count 1 $GD(plan) [list $1 $2]]
 
56
 
 
57
    if {$n > 0} {
 
58
        return "t"
 
59
    }
 
60
    return "f"
 
61
' language 'pltcl';
 
62
 
 
63
 
 
64
--
 
65
-- Trigger function on every change to T_pkey1
 
66
--
 
67
create function trig_pkey1_before() returns trigger as '
 
68
    #
 
69
    # Create prepared plans on the first call
 
70
    #
 
71
    if {![info exists GD]} {
 
72
        #
 
73
        # Plan to check for duplicate key in T_pkey1
 
74
        #
 
75
        set GD(plan_pkey1) [spi_prepare                         \\
 
76
            "select check_pkey1_exists(\\$1, \\$2) as ret"      \\
 
77
            {int4 bpchar}]
 
78
        #
 
79
        # Plan to check for references from T_dta1
 
80
        #
 
81
        set GD(plan_dta1) [spi_prepare                          \\
 
82
            "select 1 from T_dta1                               \\
 
83
                where ref1 = \\$1 and ref2 = \\$2"              \\
 
84
            {int4 bpchar}]
 
85
    }
 
86
 
 
87
    #
 
88
    # Initialize flags
 
89
    #
 
90
    set check_old_ref 0
 
91
    set check_new_dup 0
 
92
 
 
93
    switch $TG_op {
 
94
        INSERT {
 
95
            #
 
96
            # Must check for duplicate key on INSERT
 
97
            #
 
98
            set check_new_dup 1
 
99
        }
 
100
        UPDATE {
 
101
            #
 
102
            # Must check for duplicate key on UPDATE only if
 
103
            # the key changes. In that case we must check for
 
104
            # references to OLD values too.
 
105
            #
 
106
            if {[string compare $NEW(key1) $OLD(key1)] != 0} {
 
107
                set check_old_ref 1
 
108
                set check_new_dup 1
 
109
            }
 
110
            if {[string compare $NEW(key2) $OLD(key2)] != 0} {
 
111
                set check_old_ref 1
 
112
                set check_new_dup 1
 
113
            }
 
114
        }
 
115
        DELETE {
 
116
            #
 
117
            # Must only check for references to OLD on DELETE
 
118
            #
 
119
            set check_old_ref 1
 
120
        }
 
121
    }
 
122
 
 
123
    if {$check_new_dup} {
 
124
        #
 
125
        # Check for duplicate key
 
126
        #
 
127
        spi_execp -count 1 $GD(plan_pkey1) [list $NEW(key1) $NEW(key2)]
 
128
        if {$ret == "t"} {
 
129
            elog ERROR \\
 
130
                "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey1"
 
131
        }
 
132
    }
 
133
 
 
134
    if {$check_old_ref} {
 
135
        #
 
136
        # Check for references to OLD
 
137
        #
 
138
        set n [spi_execp -count 1 $GD(plan_dta1) [list $OLD(key1) $OLD(key2)]]
 
139
        if {$n > 0} {
 
140
            elog ERROR \\
 
141
                "key ''$OLD(key1)'', ''$OLD(key2)'' referenced by T_dta1"
 
142
        }
 
143
    }
 
144
 
 
145
    #
 
146
    # Anything is fine - let operation pass through
 
147
    #
 
148
    return OK
 
149
' language 'pltcl';
 
150
 
 
151
 
 
152
create trigger pkey1_before before insert or update or delete on T_pkey1
 
153
        for each row execute procedure
 
154
        trig_pkey1_before();
 
155
 
 
156
 
 
157
--
 
158
-- Trigger function to check for duplicate keys in T_pkey2
 
159
-- and to force key2 to be upper case only without leading whitespaces
 
160
--
 
161
create function trig_pkey2_before() returns trigger as '
 
162
    #
 
163
    # Prepare plan on first call
 
164
    #
 
165
    if {![info exists GD]} {
 
166
        set GD(plan_pkey2) [spi_prepare                         \\
 
167
            "select 1 from T_pkey2                              \\
 
168
                where key1 = \\$1 and key2 = \\$2"              \\
 
169
            {int4 bpchar}]
 
170
    }
 
171
 
 
172
    #
 
173
    # Convert key2 value
 
174
    #
 
175
    set NEW(key2) [string toupper [string trim $NEW(key2)]]
 
176
 
 
177
    #
 
178
    # Check for duplicate key
 
179
    #
 
180
    set n [spi_execp -count 1 $GD(plan_pkey2) [list $NEW(key1) $NEW(key2)]]
 
181
    if {$n > 0} {
 
182
        elog ERROR \\
 
183
            "duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey2"
 
184
    }
 
185
 
 
186
    #
 
187
    # Return modified tuple in NEW
 
188
    #
 
189
    return [array get NEW]
 
190
' language 'pltcl';
 
191
 
 
192
 
 
193
create trigger pkey2_before before insert or update on T_pkey2
 
194
        for each row execute procedure
 
195
        trig_pkey2_before();
 
196
 
 
197
 
 
198
--
 
199
-- Trigger function to force references from T_dta2 follow changes
 
200
-- in T_pkey2 or be deleted too. This must be done AFTER the changes
 
201
-- in T_pkey2 are done so the trigger for primkey check on T_dta2
 
202
-- fired on our updates will see the new key values in T_pkey2.
 
203
--
 
204
create function trig_pkey2_after() returns trigger as '
 
205
    #
 
206
    # Prepare plans on first call
 
207
    #
 
208
    if {![info exists GD]} {
 
209
        #
 
210
        # Plan to update references from T_dta2
 
211
        #
 
212
        set GD(plan_dta2_upd) [spi_prepare                      \\
 
213
            "update T_dta2 set ref1 = \\$3, ref2 = \\$4         \\
 
214
                where ref1 = \\$1 and ref2 = \\$2"              \\
 
215
            {int4 bpchar int4 bpchar}]
 
216
        #
 
217
        # Plan to delete references from T_dta2
 
218
        #
 
219
        set GD(plan_dta2_del) [spi_prepare                      \\
 
220
            "delete from T_dta2                                 \\
 
221
                where ref1 = \\$1 and ref2 = \\$2"              \\
 
222
            {int4 bpchar}]
 
223
    }
 
224
 
 
225
    #
 
226
    # Initialize flags
 
227
    #
 
228
    set old_ref_follow 0
 
229
    set old_ref_delete 0
 
230
 
 
231
    switch $TG_op {
 
232
        UPDATE {
 
233
            #
 
234
            # On update we must let old references follow
 
235
            #
 
236
            set NEW(key2) [string toupper $NEW(key2)]
 
237
 
 
238
            if {[string compare $NEW(key1) $OLD(key1)] != 0} {
 
239
                set old_ref_follow 1
 
240
            }
 
241
            if {[string compare $NEW(key2) $OLD(key2)] != 0} {
 
242
                set old_ref_follow 1
 
243
            }
 
244
        }
 
245
        DELETE {
 
246
            #
 
247
            # On delete we must delete references too
 
248
            #
 
249
            set old_ref_delete 1
 
250
        }
 
251
    }
 
252
 
 
253
    if {$old_ref_follow} {
 
254
        #
 
255
        # Let old references follow and fire NOTICE message if
 
256
        # there where some
 
257
        #
 
258
        set n [spi_execp $GD(plan_dta2_upd) \\
 
259
            [list $OLD(key1) $OLD(key2) $NEW(key1) $NEW(key2)]]
 
260
        if {$n > 0} {
 
261
            elog NOTICE \\
 
262
                "updated $n entries in T_dta2 for new key in T_pkey2"
 
263
        }
 
264
    }
 
265
 
 
266
    if {$old_ref_delete} {
 
267
        #
 
268
        # delete references and fire NOTICE message if
 
269
        # there where some
 
270
        #
 
271
        set n [spi_execp $GD(plan_dta2_del) \\
 
272
            [list $OLD(key1) $OLD(key2)]]
 
273
        if {$n > 0} {
 
274
            elog NOTICE \\
 
275
                "deleted $n entries from T_dta2"
 
276
        }
 
277
    }
 
278
 
 
279
    return OK
 
280
' language 'pltcl';
 
281
 
 
282
 
 
283
create trigger pkey2_after after update or delete on T_pkey2
 
284
        for each row execute procedure
 
285
        trig_pkey2_after();
 
286
 
 
287
 
 
288
--
 
289
-- Generic trigger function to check references in T_dta1 and T_dta2
 
290
--
 
291
create function check_primkey() returns trigger as '
 
292
    #
 
293
    # For every trigger/relation pair we create
 
294
    # a saved plan and hold them in GD
 
295
    #
 
296
    set plankey [list "plan" $TG_name $TG_relid]
 
297
    set planrel [list "relname" $TG_relid]
 
298
 
 
299
    #
 
300
    # Extract the pkey relation name
 
301
    #
 
302
    set keyidx [expr [llength $args] / 2]
 
303
    set keyrel [string tolower [lindex $args $keyidx]]
 
304
 
 
305
    if {![info exists GD($plankey)]} {
 
306
        #
 
307
        # We must prepare a new plan. Build up a query string
 
308
        # for the primary key check.
 
309
        #
 
310
        set keylist [lrange $args [expr $keyidx + 1] end]
 
311
 
 
312
        set query "select 1 from $keyrel"
 
313
        set qual " where"
 
314
        set typlist ""
 
315
        set idx 1
 
316
        foreach key $keylist {
 
317
            set key [string tolower $key]
 
318
            #
 
319
            # Add the qual part to the query string
 
320
            #
 
321
            append query "$qual $key = \\$$idx"
 
322
            set qual " and"
 
323
 
 
324
            #
 
325
            # Lookup the fields type in pg_attribute
 
326
            #
 
327
            set n [spi_exec "select T.typname                   \\
 
328
                from pg_catalog.pg_type T, pg_catalog.pg_attribute A, pg_catalog.pg_class C     \\
 
329
                where C.relname  = ''[quote $keyrel]''          \\
 
330
                  and C.oid      = A.attrelid                   \\
 
331
                  and A.attname  = ''[quote $key]''             \\
 
332
                  and A.atttypid = T.oid"]
 
333
            if {$n != 1} {
 
334
                elog ERROR "table $keyrel doesn''t have a field named $key"
 
335
            }
 
336
 
 
337
            #
 
338
            # Append the fields type to the argument type list
 
339
            #
 
340
            lappend typlist $typname
 
341
            incr idx
 
342
        }
 
343
 
 
344
        #
 
345
        # Prepare the plan
 
346
        #
 
347
        set GD($plankey) [spi_prepare $query $typlist]
 
348
 
 
349
        #
 
350
        # Lookup and remember the table name for later error messages
 
351
        #
 
352
        spi_exec "select relname from pg_catalog.pg_class       \\
 
353
                where oid = ''$TG_relid''::oid"
 
354
        set GD($planrel) $relname
 
355
    }
 
356
 
 
357
    #
 
358
    # Build the argument list from the NEW row
 
359
    #
 
360
    incr keyidx -1
 
361
    set arglist ""
 
362
    foreach arg [lrange $args 0 $keyidx] {
 
363
        lappend arglist $NEW($arg)
 
364
    }
 
365
 
 
366
    #
 
367
    # Check for the primary key
 
368
    #
 
369
    set n [spi_execp -count 1 $GD($plankey) $arglist]
 
370
    if {$n <= 0} {
 
371
        elog ERROR "key for $GD($planrel) not in $keyrel"
 
372
    }
 
373
 
 
374
    #
 
375
    # Anything is fine
 
376
    #
 
377
    return OK
 
378
' language 'pltcl';
 
379
 
 
380
 
 
381
create trigger dta1_before before insert or update on T_dta1
 
382
        for each row execute procedure
 
383
        check_primkey('ref1', 'ref2', 'T_pkey1', 'key1', 'key2');
 
384
 
 
385
 
 
386
create trigger dta2_before before insert or update on T_dta2
 
387
        for each row execute procedure
 
388
        check_primkey('ref1', 'ref2', 'T_pkey2', 'key1', 'key2');
 
389
 
 
390
 
 
391
create function tcl_int4add(int4,int4) returns int4 as '
 
392
    return [expr $1 + $2]
 
393
' language 'pltcl';
 
394
 
 
395
-- We use split(n) as a quick-and-dirty way of parsing the input array
 
396
-- value, which comes in as a string like '{1,2}'.  There are better ways...
 
397
 
 
398
create function tcl_int4_accum(int4[], int4) returns int4[] as '
 
399
    set state [split $1 "{,}"]
 
400
    set newsum [expr {[lindex $state 1] + $2}]
 
401
    set newcnt [expr {[lindex $state 2] + 1}]
 
402
    return "{$newsum,$newcnt}"
 
403
' language 'pltcl';
 
404
 
 
405
create function tcl_int4_avg(int4[]) returns int4 as '
 
406
    set state [split $1 "{,}"]
 
407
    if {[lindex $state 2] == 0} { return_null }
 
408
    return [expr {[lindex $state 1] / [lindex $state 2]}]
 
409
' language 'pltcl';
 
410
 
 
411
create aggregate tcl_avg (
 
412
                sfunc = tcl_int4_accum,
 
413
                basetype = int4,
 
414
                stype = int4[],
 
415
                finalfunc = tcl_int4_avg,
 
416
                initcond = '{0,0}'
 
417
        );
 
418
 
 
419
create aggregate tcl_sum (
 
420
                sfunc = tcl_int4add,
 
421
                basetype = int4,
 
422
                stype = int4,
 
423
                initcond1 = 0
 
424
        );
 
425
 
 
426
create function tcl_int4lt(int4,int4) returns bool as '
 
427
    if {$1 < $2} {
 
428
        return t
 
429
    }
 
430
    return f
 
431
' language 'pltcl';
 
432
 
 
433
create operator @< (
 
434
                leftarg = int4,
 
435
                rightarg = int4,
 
436
                procedure = tcl_int4lt
 
437
        );
 
438