/
10-mysql.t
3154 lines (2521 loc) · 88.7 KB
/
10-mysql.t
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
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# DBIish/t/10-mysql.t
# Before running the tests, prepare the database with something like:
# $ mysql -u root -p
# CREATE DATABASE zavolaj;
# CREATE USER 'testuser'@'localhost' IDENTIFIED BY 'testpass';
# GRANT SELECT ON mysql.* TO 'testuser'@'localhost';
# GRANT CREATE ON zavolaj.* TO 'testuser'@'localhost';
# GRANT DROP ON zavolaj.* TO 'testuser'@'localhost';
# GRANT INSERT ON zavolaj.* TO 'testuser'@'localhost';
# GRANT DELETE ON zavolaj.* TO 'testuser'@'localhost';
# GRANT LOCK TABLES ON zavolaj.* TO 'testuser'@'localhost';
# GRANT SELECT ON zavolaj.* TO 'testuser'@'localhost';
# # or maybe otherwise
# GRANT ALL PRIVILEGES ON zavolaj.* TO 'testuser'@'localhost';
# This '10-mysql.t' test script is a Perl 6 adaptation of the Perl 5
# based test suite for DBD::mysql version 4.014. It is experimental and
# needs lots of work to increase coverage. All the original lines
# containing tests are included here in #comments.
# Please change the Perl 6 parts of the test script freely, preserving
# just the file names from which the sections came, and the operations
# being tested. And please document generously, so that others less
# clueful than yourself can also join in the fun.
# As yet uncommented Perl 5 code is enclosed in Pod 6 '=begin pod' and
# '=end pod' markers.
use Test;
plan 87;
use DBIish;
use DBDish::mysql;
# The file 'lib.pl' customizes the testing environment per DBD, but all
# this test script currently needs is the variables listed here.
my $mdriver = 'mysql';
my $host = 'localhost';
my $port = 3306;
my $database = 'zavolaj';
my $test_user = 'testuser';
my $test_password = 'testpass';
my $table = 't1';
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/00base.t
#use Test::More tests => 6;
## Base DBD Driver Test
#BEGIN {
# use_ok('DBI') or BAIL_OUT "Unable to load DBI";
# use_ok('DBD::mysql') or BAIL_OUT "Unable to load DBD::mysql";
#}
#$switch = DBI->internal;
#cmp_ok ref $switch, 'eq', 'DBI::dr', 'Internal set';
## This is a special case. install_driver should not normally be used.
#$drh= DBI->install_driver($mdriver);
#ok $drh, 'Install driver';
#cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set';
#ok $drh->{Version}, "Version $drh->{Version}";
#print "Driver version is ", $drh->{Version}, "\n";my $mdriver = 'mysql';
my $drh;
$drh = DBIish.install_driver($mdriver);
ok $drh, 'Install driver'; # test 1
my $drh_version;
$drh_version = $drh.Version;
ok $drh_version > 0, "DBDish::mysql version $drh_version"; # test 2
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/10connect.t
#plan tests => 2;
#EVAL {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
# { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
#ok defined $dbh, "Connected to database";
#ok $dbh->disconnect();
#
my $dbh = try {
CATCH { default {
diag "Connect failed with error $_";
skip 'connect failed -- missing prereqs?', 85;
exit;
}}
DBIish.connect($mdriver, :user($test_user), :password($test_password),
:$host, :$port, :$database,
RaiseError => 1, PrintError => 1, AutoCommit => 0
);
}
# die "ERROR: {DBIish.errstr}. Can't continue test" if $!.defined;
ok $dbh.defined, "Connected to database"; # test 3
my $result = $dbh.disconnect();
ok $result, 'disconnect returned true'; # test 4
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/20createdrop.t
#plan tests => 4;
#ok(defined $dbh, "Connected to database");
#ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
#ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table");
#ok($dbh->do("DROP TABLE $table"), "dropping created $table");
#$dbh->disconnect();
try {
$dbh = DBIish.connect( $mdriver, :user($test_user), :password($test_password),
:$host, :$port, :$database,
RaiseError => 1, PrintError => 1, AutoCommit => 0 );
CATCH { die "ERROR: {DBIish.errstr}. Can't continue test\n"; }
}
ok($dbh.defined, "Connected to database"); # test 5
lives-ok({$dbh.do("DROP TABLE IF EXISTS $table")}, "making slate clean"); # test 6
lives-ok({$dbh.do("CREATE TABLE $table (id INT(4), name VARCHAR(20))")}, "creating $table"); # test 7
lives-ok({$dbh.do("DROP TABLE $table")}, "dropping created $table"); # test 8
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/25lockunlock.t
#my $create= <<EOT;
#CREATE TABLE $table (
# id int(4) NOT NULL default 0,
# name varchar(64) NOT NULL default ''
# )
#EOT
#ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
#ok $dbh->do($create), "create table $table";
#ok $dbh->do("LOCK TABLES $table WRITE"), "lock table $table";
#ok $dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert ";
#ok $dbh->do("DELETE FROM $table WHERE id = 1"), "Delete";
#EVAL {$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")};
#ok !$@, "Prepare of select";
#ok defined($sth), "Prepare of select";
#ok $sth->execute , "Execute";
#$row = $sth->fetchrow_arrayref;
#$errstr= $sth->errstr;
#ok !defined($row), "Fetch should have failed";
#ok !defined($errstr), "Fetch should have failed";
#ok $dbh->do("UNLOCK TABLES"), "Unlock tables";
#ok $dbh->do("DROP TABLE $table"), "Drop table $table";
my $create="
CREATE TABLE $table (
id int(4) NOT NULL default 0,
name varchar(30) NOT NULL default ''
)
";
lives-ok { $dbh.do("DROP TABLE IF EXISTS $table") }, "drop table if exists $table"; # test 9
lives-ok { $dbh.do($create) }, "create table $table"; # test 10
#todo "lock tables does not work";
ok $dbh.do("LOCK TABLES $table WRITE"), "lock tables $table write"; # test 11
ok $dbh.do("INSERT INTO $table VALUES(1, 'Alligator Descartes test 12')"), "Insert"; # test 12
#todo "delete works but not here";
lives-ok {$dbh.do("DELETE FROM $table WHERE id = 1") }, "Delete"; # test 13
my $sth;
try {
$sth= $dbh.prepare("SELECT * FROM $table WHERE id = 1");
}
ok defined($sth), "Prepare of select"; # test 14
ok $sth.execute , "Execute"; # test 15
my ($row, $errstr);
$row = $sth.fetchrow_arrayref();
$errstr= $sth.errstr;
nok $row, "Fetch should have failed"; # test 16
nok $errstr, "Fetch should have failed"; # test 17
ok $dbh.do("UNLOCK TABLES"), "Unlock tables"; # test 18
ok $dbh.do("DROP TABLE $table"), "Drop table $table"; # test 19
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/29warnings.t
#SKIP: {
# skip "Server doesn't report warnings", 3
# if $dbh->get_info($GetInfoType{SQL_DBMS_VER}) lt "4.1";
# my $sth;
# ok($sth= $dbh->prepare("DROP TABLE IF EXISTS no_such_table"));
# ok($sth->execute());
# is($sth->{mysql_warning_count}, 1);
#};
#try {
# $dbh = DBIish.connect( $test_dsn, $test_user, $test_password,
# RaiseError => 1, PrintError => 1, AutoCommit => 0 );
# CATCH { die "ERROR: {DBIish.errstr}. Can't continue test\n"; }
#}
ok($sth= $dbh.prepare("DROP TABLE IF EXISTS no_such_table"), "prepare drop no_such_table"); # test 20
ok($sth.execute(), "execute drop no_such_table..."); # test 21
is($sth.mysql_warning_count, 1, "...returns an error"); # test 22
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/30insertfetch.t
#plan tests => 10;
#ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
#ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table");
#ok($dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "loading data");
#ok($dbh->do("DELETE FROM $table WHERE id = 1"), "deleting from table $table");
#ok (my $sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1"));
#ok($sth->execute());
#ok(not $sth->fetchrow_arrayref());
#ok($sth->finish());
#ok($dbh->do("DROP TABLE $table"),"Dropping table");
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/31insertid.t
#plan tests => 18;
#ok $dbh->do("DROP TABLE IF EXISTS $table");
#my $create = <<EOT;
#CREATE TABLE $table (
# id INT(3) PRIMARY KEY AUTO_INCREMENT NOT NULL,
# name VARCHAR(64))
#EOT
#ok $dbh->do($create), "create $table";
#my $query= "INSERT INTO $table (name) VALUES (?)";
#ok ($sth= $dbh->prepare($query));
#ok defined $sth;
#ok $sth->execute("Jochen");
#is $dbh->{'mysql_insertid'}, 1, "insert id == $dbh->{mysql_insertid}";
#ok $sth->execute("Patrick");
#ok (my $sth2= $dbh->prepare("SELECT max(id) FROM $table"));
#ok defined $sth2;
#ok $sth2->execute();
#my $max_id;
#ok ($max_id= $sth2->fetch());
#ok defined $max_id;
#cmp_ok $sth->{'mysql_insertid'}, '==', $max_id->[0], "sth insert id $sth->{'mysql_insertid'} == max(id) $max_id->[0] in $table";
#cmp_ok $dbh->{'mysql_insertid'}, '==', $max_id->[0], "dbh insert id $dbh->{'mysql_insertid'} == max(id) $max_id->[0] in $table";
#ok $sth->finish();
#ok $sth2->finish();
#ok $dbh->do("DROP TABLE $table");
#ok $dbh->disconnect();
ok $dbh.do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; # test 23
$create = "
CREATE TABLE $table (
id INT(3) PRIMARY KEY AUTO_INCREMENT NOT NULL,
name VARCHAR(31))
";
ok $dbh.do($create), "create $table"; # test 24
my $query= "INSERT INTO $table (name) VALUES (?)";
ok ($sth= $dbh.prepare($query)), "prepare insert with parameter"; # test 25
ok $sth.execute("Jochen"), "execute insert with parameter"; # test 26
is $dbh.mysql_insertid, 1, "insert id == \$dbh.mysql_insertid (but only int, not long long)"; # test 27
ok $sth.execute("Patrick"), "execute 2nd insert with parameter"; # test 28
ok (my $sth2= $dbh.prepare("SELECT max(id) FROM $table")),"selectg max(id)"; # test 29
ok $sth2.defined,"second prepared statement"; # test 30
ok $sth2.execute(), "execute second prepared statement"; # test 31
my $max_id;
ok ($max_id= $sth2.fetch()),"fetch"; # test 32
ok $max_id.defined,"fetch result defined"; # test 33
ok $sth.mysql_insertid == $max_id[0], 'sth insert id $sth.mysql_insertid == max(id) $max_id[0] in '~$table; # test 34
ok $dbh.mysql_insertid == $max_id[0], 'dbh insert id $dbh.mysql_insertid == max(id) $max_id[0] in '~$table; # test 35
ok $sth.finish(), "statement 1 finish"; # test 36
ok $sth2.finish(), "statement 2 finish"; # test 37
ok $dbh.do("DROP TABLE $table"),"drop table $table"; # test 38
# Because the drop table might fail, disconnect and reconnect
$dbh.disconnect();
try {
$dbh = DBIish.connect( $mdriver, :user($test_user), :password($test_password),
:$host, :$port, :$database,
RaiseError => 1, PrintError => 1, AutoCommit => 0 );
CATCH { die "ERROR: {DBIish.errstr}. Can't continue test\n"; }
}
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/32insert_error.t
# Test problem in 3.0002_4 and 3.0005 where if a statement is prepared
# and multiple executes are performed, if any execute fails all subsequent
# executes report an error but may have worked.
#plan tests => 9;
#ok $dbh->do("DROP TABLE IF EXISTS $table");
#my $create = <<EOT;
#CREATE TABLE $table (
# id INT(3) PRIMARY KEY NOT NULL,
# name VARCHAR(64))
#EOT
#ok $dbh->do($create);
#my $query = "INSERT INTO $table (id, name) VALUES (?,?)";
#ok (my $sth = $dbh->prepare($query));
#ok $sth->execute(1, "Jocken");
#$sth->{PrintError} = 0;
#EVAL {$sth->execute(1, "Jochen")};
#ok defined($@), 'fails with duplicate entry'; # $@ is last EVAL error message
#$sth->{PrintError} = 1;
#ok $sth->execute(2, "Jochen");
#ok $sth->finish;
#ok $dbh->do("DROP TABLE $table");
#ok $dbh->disconnect();
ok $dbh.do("DROP TABLE IF EXISTS $table"),"drop table if exists $table"; # test 39
$create = "
CREATE TABLE $table (
id INT(3) PRIMARY KEY NOT NULL,
name VARCHAR(32))
";
ok $dbh.do($create), "create $table"; # test 40
$query = "INSERT INTO $table (id, name) VALUES (?,?)";
ok ($sth = $dbh.prepare($query)),"prepare $query"; # test 41
ok $sth.execute(1, "Jocken"), "execute insert Jocken"; # test 42
$sth.PrintError = Bool::False;
dies-ok { $sth.execute(1, 'Jochen') }, 'fails with duplicate entry'; # test 43
ok $sth.errstr.defined, '... and got an error in $sth.errstr'; # test 44
$sth.PrintError = Bool::True;
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/35limit.t
#plan tests => 111;
#ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
#ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating table");
#ok(($sth = $dbh->prepare("INSERT INTO $table VALUES (?,?)")));
#print "PERL testing insertion of values from previous prepare of insert statement:\n";
#for (my $i = 0 ; $i < 100; $i++) {
# my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
# my $random_chars = join '', map { $chars[rand @chars] } 0 .. 16;
## save these values for later testing
# $testInsertVals->{$i} = $random_chars;
# ok(($rows = $sth->execute($i, $random_chars)));
#}
#print "PERL rows : " . $rows . "\n";
#print "PERL testing prepare of select statement with LIMIT placeholders:\n";
#ok($sth = $dbh->prepare("SELECT * FROM $table LIMIT ?, ?"));
#print "PERL testing exec of bind vars for LIMIT\n";
#ok($sth->execute(20, 50));
#my ($row, $errstr, $array_ref);
#ok( (defined($array_ref = $sth->fetchall_arrayref) &&
# (!defined($errstr = $sth->errstr) || $sth->errstr eq '')));
#ok(@$array_ref == 50);
#ok($sth->finish);
#ok($dbh->do("DROP TABLE $table"));
ok($dbh.do("DROP TABLE IF EXISTS $table"), "making slate clean"); # test 45
ok($dbh.do("CREATE TABLE $table (id INT(4), name VARCHAR(35))"), "creating table"); # test 46
ok(($sth = $dbh.prepare("INSERT INTO $table (id,name) VALUES (?,?)")),"prepare insert with 2 params"); # test 47
my ( %testInsertVals, $all_ok );
$all_ok = Bool::True;
loop (my $i = 0 ; $i < 100; $i++) {
my @chars = grep /<-[0O1Iil]>/, 0..9, 'A'..'Z', 'a'..'z';
my $random_chars = @chars.roll(16).join;
%testInsertVals{$i} = $random_chars; # save these values for later testing
unless $sth.execute($i, $random_chars) { $all_ok = Bool::False; }
}
ok( $all_ok,"insert 100 rows of random chars"); # test 48
ok($sth = $dbh.prepare("SELECT * FROM $table LIMIT ?, ?"),"prepare of select statement with LIMIT placeholders:"); # test 49
ok($sth.execute(20, 50),"exec of bind vars for LIMIT"); # test 50
my ($array_ref);
ok( (defined($array_ref = $sth.fetchall_arrayref) &&
(!defined($errstr = $sth.errstr) || $sth.errstr eq '')),"fetchall_arrayref"); # test 51
is($array_ref.elems, 50,"limit 50 works"); # test 52
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/35prepare.t
#plan tests => 49;
#ok($dbh->do("DROP TABLE IF EXISTS t1"), "Making slate clean");
#ok($dbh->do("CREATE TABLE t1 (id INT(4), name VARCHAR(64))"),
# "Creating table");
#ok($sth = $dbh->prepare("SHOW TABLES LIKE 't1'"),
# "Testing prepare show tables");
#ok($sth->execute(), "Executing 'show tables'");
#ok((defined($row= $sth->fetchrow_arrayref) &&
# (!defined($errstr = $sth->errstr) || $sth->errstr eq '')),
# "Testing if result set and no errors");
#ok($row->[0] eq 't1', "Checking if results equal to 't1' \n");
#ok($sth->finish, "Finishing up with statement handle");
#ok($dbh->do("INSERT INTO t1 VALUES (1,'1st first value')"),
# "Inserting first row");
#ok($sth= $dbh->prepare("INSERT INTO t1 VALUES (2,'2nd second value')"),
# "Preparing insert of second row");
#ok(($rows = $sth->execute()), "Inserting second row");
#ok($rows == 1, "One row should have been inserted");
#ok($sth->finish, "Finishing up with statement handle");
#ok($sth= $dbh->prepare("SELECT id, name FROM t1 WHERE id = 1"),
# "Testing prepare of query");
#ok($sth->execute(), "Testing execute of query");
#ok($ret_ref = $sth->fetchall_arrayref(),
# "Testing fetchall_arrayref of executed query");
#ok($sth= $dbh->prepare("INSERT INTO t1 values (?, ?)"),
# "Preparing insert, this time using placeholders");
#my $testInsertVals = {};
#for (my $i = 0 ; $i < 10; $i++)
#{
# my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
# my $random_chars= join '', map { $chars[rand @chars] } 0 .. 16;
# # save these values for later testing
# $testInsertVals->{$i}= $random_chars;
# ok($rows= $sth->execute($i, $random_chars), "Testing insert row");
# ok($rows= 1, "Should have inserted one row");
#}
#ok($sth->finish, "Testing closing of statement handle");
#ok($sth= $dbh->prepare("SELECT * FROM t1 WHERE id = ? OR id = ?"),
# "Testing prepare of query with placeholders");
#ok($rows = $sth->execute(1,2),
# "Testing execution with values id = 1 or id = 2");
#ok($ret_ref = $sth->fetchall_arrayref(),
# "Testing fetchall_arrayref (should be four rows)");
#print "RETREF " . scalar @$ret_ref . "\n";
#ok(@{$ret_ref} == 4 , "\$ret_ref should contain four rows in result set");
#ok($sth= $dbh->prepare("DROP TABLE IF EXISTS t1"),
# "Testing prepare of dropping table");
#ok($sth->execute(), "Executing drop table");
# Bug #20153: Fetching all data from a statement handle does not mark it
# as finished
#ok($sth= $dbh->prepare("SELECT 1"), "Prepare - Testing bug #20153");
#ok($sth->execute(), "Execute - Testing bug #20153");
#ok($sth->fetchrow_arrayref(), "Fetch - Testing bug #20153");
#ok(!($sth->fetchrow_arrayref()),"Not Fetch - Testing bug #20153");
## Install a handler so that a warning about unfreed resources gets caught
#$SIG{__WARN__} = sub { die @_ };
#ok($dbh->disconnect(), "Testing disconnect");
ok($dbh.do("DROP TABLE IF EXISTS t1"), "35prepare.t Making slate clean"); # test 53
ok($dbh.do("CREATE TABLE t1 (id INT(4), name VARCHAR(35))"), "Creating table"); # test 54
ok($sth = $dbh.prepare("SHOW TABLES LIKE 't1'"),"prepare show tables"); # test 55
ok($sth.execute(), "Executing 'show tables'"); # test 56
my @row;
ok((defined(@row = $sth.fetchrow_array) &&
(!defined($errstr = $sth.errstr) || $sth.errstr eq '')),
"Testing if result set and no errors"); # test 57
is(@row[0], 't1', "Checking if results equal to 't1'"); # test 58
ok($sth.finish, "Finishing up with statement handle"); # test 59
ok($dbh.do("INSERT INTO t1 VALUES (1,'1st first value')"),"Inserting first row"); # test 60
ok($sth= $dbh.prepare("INSERT INTO t1 VALUES (2,'2nd second value')"),"Preparing insert of second row"); # test 61
my $rows;
ok(($rows = $sth.execute()), "Inserting second row"); # test 62
is($rows, 1, "One row should have been inserted"); # test 63
ok($sth.finish, "Finishing up with statement handle"); # test 64
ok($sth= $dbh.prepare("SELECT id, name FROM t1 WHERE id = 1"),"Testing prepare of query"); # test 65
ok($sth.execute(), "Testing execute of query"); # test 66
ok(my $ret_ref = $sth.fetchall_arrayref(),"Testing fetchall_arrayref of executed query"); # test 67
ok($sth= $dbh.prepare("INSERT INTO t1 values (?, ?)"),"Preparing insert, this time using placeholders"); # test 68
%testInsertVals = ();
$all_ok = Bool::True;
loop ($i = 0 ; $i < 10; $i++) {
my @chars = grep /<-[0O1Iil]> /, flat 0..9, 'A'..'Z', 'a'..'z';
my $random_chars= @chars.roll(16).join('');
%testInsertVals{$i}= $random_chars; # save these values for later testing
unless $sth.execute($i, $random_chars) { $all_ok = Bool::False; }
}
ok($all_ok, "Should have inserted one row (10 times)"); # test 69
ok($sth.finish, "Testing closing of statement handle"); # test 70
ok($sth= $dbh.prepare("SELECT * FROM t1 WHERE id = ? OR id = ?"),"Testing prepare of query with placeholders"); # test 71
ok($rows = $sth.execute(1,2),"Testing execution with values id = 1 or id = 2"); # test 72
ok($ret_ref = $sth.fetchall_arrayref(),"Testing fetchall_arrayref (should be four rows)"); # test 73
is($ret_ref.elems, 4, "\$ret_ref should contain four rows in result set"); # test 74
is($ret_ref[2][1], %testInsertVals{'1'}, "verify third row"); # test 75
ok($sth= $dbh.prepare("DROP TABLE IF EXISTS t1"),"Testing prepare of dropping table"); # test 76
ok($sth.execute(), "Executing drop table"); # test 77
ok($sth= $dbh.prepare("SELECT 1"), "Prepare - Testing bug #20153"); # test 78
ok($sth.execute(), "Execute - Testing bug #20153"); # test 79
ok($sth.fetchrow_arrayref(), "Fetch - Testing bug #20153"); # test 80
ok(!($sth.fetchrow_arrayref()),"Not Fetch - Testing bug #20153"); # test 81
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/40bindparam.t
#plan tests => 41;
#ok ($dbh->do("DROP TABLE IF EXISTS $table"));
#my $create = <<EOT;
#CREATE TABLE $table (
# id int(4) NOT NULL default 0,
# name varchar(64) default ''
# )
#EOT
#ok ($dbh->do($create));
#ok ($sth = $dbh->prepare("INSERT INTO $table VALUES (?, ?)"));
# Automatic type detection
#my $numericVal = 1;
#my $charVal = "Alligator Descartes";
#ok ($sth->execute($numericVal, $charVal));
# Does the driver remember the automatically detected type?
#ok ($sth->execute("3", "Jochen Wiedmann"));
#$numericVal = 2;
#$charVal = "Tim Bunce";
#ok ($sth->execute($numericVal, $charVal));
# Now try the explicit type settings
#ok ($sth->bind_param(1, " 4", SQL_INTEGER()));
# umlaut equivelant is vowel followed by 'e'
#ok ($sth->bind_param(2, 'Andreas Koenig'));
#ok ($sth->execute);
# Works undef -> NULL?
#ok ($sth->bind_param(1, 5, SQL_INTEGER()));
#ok ($sth->bind_param(2, undef));
#ok ($sth->execute);
#ok ($sth->bind_param(1, undef, SQL_INTEGER()));
#ok ($sth->bind_param(2, undef));
#ok ($sth->execute(-1, "abc"));
#ok ($dbh->do("INSERT INTO $table VALUES (6, '?')"));
#ok ($dbh->do('SET @old_sql_mode = @@sql_mode, @@sql_mode = \'\''));
#ok ($dbh->do("INSERT INTO $table VALUES (7, \"?\")"));
#ok ($dbh->do('SET @@sql_mode = @old_sql_mode'));
#ok ($sth = $dbh->prepare("SELECT * FROM $table ORDER BY id"));
#ok($sth->execute);
#ok ($sth->bind_columns(undef, \$id, \$name));
#$ref = $sth->fetch ;
#is $id, -1, 'id set to -1';
#cmp_ok $name, 'eq', 'abc', 'name eq abc';
#$ref = $sth->fetch;
#is $id, 1, 'id set to 1';
#cmp_ok $name, 'eq', 'Alligator Descartes', '$name set to Alligator Descartes';
#$ref = $sth->fetch;
#is $id, 2, 'id set to 2';
#cmp_ok $name, 'eq', 'Tim Bunce', '$name set to Tim Bunce';
#$ref = $sth->fetch;
#is $id, 3, 'id set to 3';
#cmp_ok $name, 'eq', 'Jochen Wiedmann', '$name set to Jochen Wiedmann';
#$ref = $sth->fetch;
#is $id, 4, 'id set to 4';
#cmp_ok $name, 'eq', 'Andreas Koenig', '$name set to Andreas Koenig';
#$ref = $sth->fetch;
#is $id, 5, 'id set to 5';
#ok !defined($name), 'name not defined';
#$ref = $sth->fetch;
#is $id, 6, 'id set to 6';
#cmp_ok $name, 'eq', '?', "\$name set to '?'";
#$ref = $sth->fetch;
#is $id, 7, '$id set to 7';
#cmp_ok $name, 'eq', '?', "\$name set to '?'";
#ok ($dbh->do("DROP TABLE $table"));
#ok $sth->finish;
#ok $dbh->disconnect;
ok ($dbh.do("DROP TABLE IF EXISTS $table")),"drop table before 40bindparam.t"; # test 82
$create = "
CREATE TABLE $table (
id int(4) NOT NULL default 0,
name varchar(40) default ''
)
";
ok ($dbh.do($create)),"create table with defaults"; # test 83
ok ($sth = $dbh.prepare("INSERT INTO $table VALUES (?, ?)")),"prepare parameterized insert"; # test 84
my $numericVal = 1; # Automatic type detection
my $charVal = "Alligator Descartes";
ok ($sth.execute($numericVal, $charVal)),"execute insert with numeric and char"; # test 85
# Does the driver remember the automatically detected type?
ok ($sth.execute("3", "Jochen Wiedmann")),"insert with string for numeric field"; # test 86
$numericVal = 2;
$charVal = "Tim Bunce";
ok ($sth.execute($numericVal, $charVal)),"insert with number for numeric"; # test 87
# Now try the explicit type settings
#ok ($sth.bind_param(1, " 4", SQL_INTEGER())),"bind_param SQL_INTEGER"; # test 88
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/40bindparam2.t
#EVAL {$dbh = DBI->connect($test_dsn, $test_user, $test_password,
# { RaiseError => 1, AutoCommit => 1}) or ServerError();};
#if ($@) {
# plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
#}
#plan tests => 13;
#ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table $table";
#my $create= <<EOT;
#CREATE TABLE $table (
# id INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
# num INT(3))
#EOT
#ok $dbh->do($create), "create table $table";
#ok $dbh->do("INSERT INTO $table VALUES(NULL, 1)"), "insert into $table (null, 1)";
#my $rows;
#ok ($rows= $dbh->selectall_arrayref("SELECT * FROM $table"));
#is $rows->[0][1], 1, "\$rows->[0][1] == 1";
#ok ($sth = $dbh->prepare("UPDATE $table SET num = ? WHERE id = ?"));
#ok ($sth->bind_param(2, 1, SQL_INTEGER()));
#ok ($sth->execute());
#ok ($sth->finish());
#ok ($rows = $dbh->selectall_arrayref("SELECT * FROM $table"));
#ok !defined($rows->[0][1]);
#ok ($dbh->do("DROP TABLE $table"));
#ok ($dbh->disconnect());
#ok $dbh.do("DROP TABLE IF EXISTS $table"), "drop table $table"; # test 87
#$create= "
#CREATE TABLE $table (
# id INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
# num INT(3))
#";
#ok $dbh.do($create), "create table $table"; # test 88
#ok $dbh.do("INSERT INTO $table VALUES(NULL, 1)"), "insert into $table (null, 1)"; # test 89
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/40blobs.t
# This is a test for correct handling of BLOBS; namely $dbh->quote
# is expected to work correctly.
#sub ShowBlob($) {
# my ($blob) = @_;
# for ($i = 0; $i < 8; $i++) {
# if (defined($blob) && length($blob) > $i) {
# $b = substr($blob, $i*32);
# }
# else {
# $b = "";
# }
# printf("%08lx %s\n", $i*32, unpack("H64", $b));
# }
#}
#my $charset= 'DEFAULT CHARSET=utf8';
#plan tests => 14;
#if ($dbh->get_info($GetInfoType{SQL_DBMS_VER}) lt "4.1") {
# $charset= '';
#}
#my $size= 128;
#ok $dbh->do("DROP TABLE IF EXISTS $table"), "Drop table if exists $table";
#my $create = <<EOT;
#CREATE TABLE $table (
# id INT(3) NOT NULL DEFAULT 0,
# name BLOB ) $charset
#EOT
#ok ($dbh->do($create));
#my ($blob, $qblob) = "";
#my $b = "";
#for ($j = 0; $j < 256; $j++) {
# $b .= chr($j);
#}
#for ($i = 0; $i < $size; $i++) {
# $blob .= $b;
#}
#ok ($qblob = $dbh->quote($blob));
# Insert a row into the test table.......
#my ($query);
#$query = "INSERT INTO $table VALUES(1, $qblob)";
#ok ($dbh->do($query));
# Now, try SELECT'ing the row out.
#ok ($sth = $dbh->prepare("SELECT * FROM $table WHERE id = 1"));
#ok ($sth->execute);
#ok ($row = $sth->fetchrow_arrayref);
#ok defined($row), "row returned defined";
#is @$row, 2, "records from $table returned 2";
#is $$row[0], 1, 'id set to 1';
#cmp_ok byte_string($$row[1]), 'eq', byte_string($blob), 'blob set equal to blob returned';
#ShowBlob($blob), ShowBlob(defined($$row[1]) ? $$row[1] : "");
#ok ($sth->finish);
#ok $dbh->do("DROP TABLE $table"), "Drop table $table";
#ok $dbh->disconnect;
=begin pod
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/40catalog.t
#EVAL {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
# { RaiseError => 1,
# PrintError => 1,
# AutoCommit => 0,
# mysql_server_prepare => 0 });};
#plan tests => 77;
#ok(defined $dbh, "connecting");
#my $sth;
#my ($version)= $dbh->selectrow_array("SELECT version()")
# or DbiError($dbh->err, $dbh->errstr);
#
# Bug #26604: foreign_key_info() implementation
#
# The tests for this are adapted from the Connector/J test suite.
#
SKIP: {
skip "Server is too old to support INFORMATION_SCHEMA for foreign keys", 16
if substr($version, 0, 1) < 5;
my ($dummy,$have_innodb)=
$dbh->selectrow_array("SHOW VARIABLES LIKE 'have_innodb'")
or DbiError($dbh->err, $dbh->errstr);
skip "Server doesn't support InnoDB, needed for testing foreign keys", 16
unless defined $have_innodb && $have_innodb eq "YES";
ok($dbh->do(qq{DROP TABLE IF EXISTS child, parent}), "cleaning up");
ok($dbh->do(qq{CREATE TABLE parent(id INT NOT NULL,
PRIMARY KEY (id)) ENGINE=INNODB}));
ok($dbh->do(qq{CREATE TABLE child(id INT, parent_id INT,
FOREIGN KEY (parent_id)
REFERENCES parent(id) ON DELETE SET NULL)
ENGINE=INNODB}));
$sth= $dbh->foreign_key_info(undef, undef, "parent", undef, undef, "child");
my ($info)= $sth->fetchall_arrayref({});
is($info->[0]->{PKTABLE_NAME}, "parent");
is($info->[0]->{PKCOLUMN_NAME}, "id");
is($info->[0]->{FKTABLE_NAME}, "child");
is($info->[0]->{FKCOLUMN_NAME}, "parent_id");
$sth= $dbh->foreign_key_info(undef, undef, "parent", undef, undef, undef);
($info)= $sth->fetchall_arrayref({});
is($info->[0]->{PKTABLE_NAME}, "parent");
is($info->[0]->{PKCOLUMN_NAME}, "id");
is($info->[0]->{FKTABLE_NAME}, "child");
is($info->[0]->{FKCOLUMN_NAME}, "parent_id");
$sth= $dbh->foreign_key_info(undef, undef, undef, undef, undef, "child");
($info)= $sth->fetchall_arrayref({});
is($info->[0]->{PKTABLE_NAME}, "parent");
is($info->[0]->{PKCOLUMN_NAME}, "id");
is($info->[0]->{FKTABLE_NAME}, "child");
is($info->[0]->{FKCOLUMN_NAME}, "parent_id");
ok($dbh->do(qq{DROP TABLE IF EXISTS child, parent}), "cleaning up");
};
#
# table_info() tests
#
# These tests assume that no other tables name like 't_dbd_mysql_%' exist on
# the server we are using for testing.
#
SKIP: {
skip "Server can't handle tricky table names", 33
if $dbh->get_info($GetInfoType{SQL_DBMS_VER}) lt "4.1";
my $sth = $dbh->table_info("%", undef, undef, undef);
is(scalar @{$sth->fetchall_arrayref()}, 0, "No catalogs expected");
$sth = $dbh->table_info(undef, "%", undef, undef);
ok(scalar @{$sth->fetchall_arrayref()} > 0, "Some schemas expected");
$sth = $dbh->table_info(undef, undef, undef, "%");
ok(scalar @{$sth->fetchall_arrayref()} > 0, "Some table types expected");
ok($dbh->do(qq{DROP TABLE IF EXISTS t_dbd_mysql_t1, t_dbd_mysql_t11,
t_dbd_mysql_t2, t_dbd_mysqlat2,
`t_dbd_mysql_a'b`,
`t_dbd_mysql_a``b`}),
"cleaning up");
ok($dbh->do(qq{CREATE TABLE t_dbd_mysql_t1 (a INT)}) and
$dbh->do(qq{CREATE TABLE t_dbd_mysql_t11 (a INT)}) and
$dbh->do(qq{CREATE TABLE t_dbd_mysql_t2 (a INT)}) and
$dbh->do(qq{CREATE TABLE t_dbd_mysqlat2 (a INT)}) and
$dbh->do(qq{CREATE TABLE `t_dbd_mysql_a'b` (a INT)}) and
$dbh->do(qq{CREATE TABLE `t_dbd_mysql_a``b` (a INT)}),
"creating test tables");
# $base is our base table name, with the _ escaped to avoid extra matches
my $esc = $dbh->get_info(14); # SQL_SEARCH_PATTERN_ESCAPE
(my $base = "t_dbd_mysql_") =~ s/([_%])/$esc$1/g;
# Test fetching info on a single table
$sth = $dbh->table_info(undef, undef, $base . "t1", undef);
my $info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_CAT}, undef);
is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t1");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 1, "one row expected");
# Test fetching info on a wildcard
$sth = $dbh->table_info(undef, undef, $base . "t1%", undef);
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_CAT}, undef);
is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t1");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is($info->[1]->{TABLE_CAT}, undef);
is($info->[1]->{TABLE_NAME}, "t_dbd_mysql_t11");
is($info->[1]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 2, "two rows expected");
# Test fetching info on a single table with escaped wildcards
$sth = $dbh->table_info(undef, undef, $base . "t2", undef);
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_CAT}, undef);
is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_t2");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 1, "only one table expected");
# Test fetching info on a single table with ` in name
$sth = $dbh->table_info(undef, undef, $base . "a`b", undef);
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_CAT}, undef);
is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_a`b");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 1, "only one table expected");
# Test fetching info on a single table with ' in name
$sth = $dbh->table_info(undef, undef, $base . "a'b", undef);
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_CAT}, undef);
is($info->[0]->{TABLE_NAME}, "t_dbd_mysql_a'b");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 1, "only one table expected");
# Test fetching our tables with a wildcard schema
# NOTE: the performance of this could be bad if the mysql user we
# are connecting as can see lots of databases.
$sth = $dbh->table_info(undef, "%", $base . "%", undef);
$info = $sth->fetchall_arrayref({});
is(scalar @$info, 5, "five tables expected");
# Check that tables() finds and escapes the tables named with quotes
$info = [ $dbh->tables(undef, undef, $base . 'a%') ];
like($info->[0], qr/\.`t_dbd_mysql_a'b`$/, "table with single quote");
like($info->[1], qr/\.`t_dbd_mysql_a``b`$/, "table with back quote");
is(scalar @$info, 2, "two tables expected");
# Clean up
ok($dbh->do(qq{DROP TABLE IF EXISTS t_dbd_mysql_t1, t_dbd_mysql_t11,
t_dbd_mysql_t2, t_dbd_mysqlat2,
`t_dbd_mysql_a'b`,
`t_dbd_mysql_a``b`}),
"cleaning up");
};
#
# view-related table_info tests
#
SKIP: {
skip "Server is too old to support views", 19
if substr($version, 0, 1) < 5;
#
# Bug #26603: (one part) support views in table_info()
#
ok($dbh->do(qq{DROP VIEW IF EXISTS bug26603_v1}) and
$dbh->do(qq{DROP TABLE IF EXISTS bug26603_t1}), "cleaning up");
ok($dbh->do(qq{CREATE TABLE bug26603_t1 (a INT)}) and
$dbh->do(qq{CREATE VIEW bug26603_v1 AS SELECT * FROM bug26603_t1}),
"creating resources");
# Try without any table type specified
$sth = $dbh->table_info(undef, undef, "bug26603%");
my $info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_NAME}, "bug26603_t1");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is($info->[1]->{TABLE_NAME}, "bug26603_v1");
is($info->[1]->{TABLE_TYPE}, "VIEW");
is(scalar @$info, 2, "two rows expected");
# Just get the view
$sth = $dbh->table_info(undef, undef, "bug26603%", "VIEW");
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_NAME}, "bug26603_v1");
is($info->[0]->{TABLE_TYPE}, "VIEW");
is(scalar @$info, 1, "one row expected");
# Just get the table
$sth = $dbh->table_info(undef, undef, "bug26603%", "TABLE");
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_NAME}, "bug26603_t1");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is(scalar @$info, 1, "one row expected");
# Get both tables and views
$sth = $dbh->table_info(undef, undef, "bug26603%", "'TABLE','VIEW'");
$info = $sth->fetchall_arrayref({});
is($info->[0]->{TABLE_NAME}, "bug26603_t1");
is($info->[0]->{TABLE_TYPE}, "TABLE");
is($info->[1]->{TABLE_NAME}, "bug26603_v1");
is($info->[1]->{TABLE_TYPE}, "VIEW");
is(scalar @$info, 2, "two rows expected");
ok($dbh->do(qq{DROP VIEW IF EXISTS bug26603_v1}) and
$dbh->do(qq{DROP TABLE IF EXISTS bug26603_t1}), "cleaning up");
};
#
# column_info() tests
#
SKIP: {
ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "cleaning up");
ok($dbh->do(qq{CREATE TABLE t1 (a INT PRIMARY KEY AUTO_INCREMENT,
b INT,
`a_` INT,
`a'b` INT,
bar INT
)}), "creating table");
#
# Bug #26603: (one part) add mysql_is_autoincrement
#
$sth= $dbh->column_info(undef, undef, "t1", 'a');
my ($info)= $sth->fetchall_arrayref({});
is($info->[0]->{mysql_is_auto_increment}, 1);
$sth= $dbh->column_info(undef, undef, "t1", 'b');
($info)= $sth->fetchall_arrayref({});
is($info->[0]->{mysql_is_auto_increment}, 0);
#
# Test that wildcards and odd names are handled correctly
#
$sth= $dbh->column_info(undef, undef, "t1", "a%");
($info)= $sth->fetchall_arrayref({});
is(scalar @$info, 3);
$sth= $dbh->column_info(undef, undef, "t1", "a" . $dbh->get_info(14) . "_");
($info)= $sth->fetchall_arrayref({});
is(scalar @$info, 1);
$sth= $dbh->column_info(undef, undef, "t1", "a'b");
($info)= $sth->fetchall_arrayref({});
is(scalar @$info, 1);
ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "cleaning up");
$dbh->disconnect();
};
$dbh->disconnect();
#-----------------------------------------------------------------------
#!perl -w
# vim: ft=perl
use Test::More;
use DBI;
use strict;
use lib 't', '.';
require 'lib.pl';
$|= 1;
use vars qw($table $test_dsn $test_user $test_password);
my $dbh;
EVAL {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
{ RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
if ($@) {
plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
plan tests => 7;
$dbh->{mysql_server_prepare}= 0;
ok(defined $dbh, "Connected to database for key info tests");
ok($dbh->do("DROP TABLE IF EXISTS $table"), "Dropped table");
# Non-primary key is there as a regression test for Bug #26786.
ok($dbh->do("CREATE TABLE $table (a int, b varchar(20), c int,
primary key (a,b(10)), key (c))"),
"Created table $table");
my $sth= $dbh->primary_key_info(undef, undef, $table);
ok($sth, "Got primary key info");
my $key_info= $sth->fetchall_arrayref;
my $expect= [
[ undef, undef, $table, 'a', '1', 'PRIMARY' ],
[ undef, undef, $table, 'b', '2', 'PRIMARY' ],
];
is_deeply($key_info, $expect, "Check primary_key_info results");
is_deeply([ $dbh->primary_key(undef, undef, $table) ], [ 'a', 'b' ],
"Check primary_key results");
ok($dbh->do("DROP TABLE $table"), "Dropped table");
$dbh->disconnect();
#-----------------------------------------------------------------------
#!perl -w
# vim: ft=perl
#
# $Id: 40listfields.t 11244 2008-05-11 15:13:10Z capttofu $
#
# This is a test for statement attributes being present appropriately.
#
#
# Include lib.pl
#
use DBI;
use Test::More;
use vars qw($verbose);
use lib '.', 't';
require 'lib.pl';
use vars qw($test_dsn $test_user $test_password);
my $quoted;
my $create;
my $dbh;
EVAL {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
{ RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
if ($@) {
plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
}
plan tests => 25;
$dbh->{mysql_server_prepare}= 0;
ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
$create = <<EOC;
CREATE TABLE $table (
id INT(4) NOT NULL,
name VARCHAR(64),
key id (id)
)
EOC
ok $dbh->do($create), "create table $table";
ok $dbh->table_info(undef,undef,$table), "table info for $table";
ok $dbh->column_info(undef,undef,$table,'%'), "column_info for $table";
$sth= $dbh->column_info(undef,undef,"this_does_not_exist",'%');
ok $sth, "\$sth defined";