forked from dalibo/sqlserver2pgsql
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathsqlserver2pgsql.pl
More file actions
executable file
·1970 lines (1867 loc) · 77.2 KB
/
Copy pathsqlserver2pgsql.pl
File metadata and controls
executable file
·1970 lines (1867 loc) · 77.2 KB
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
#!/usr/bin/perl -w
# This script takes a sql server SQL schema dump, and creates a postgresql dump
# Optionnaly, if asked, generate a kettle job to transfer all data. This is done via -k dir
# Details in the README file
# This program is made to die on all error conditions: if there is something not understood in
# a dump, it has to be added, or manually ignored (in order to improve this program rapidly)
# Licence: GPLv3
# Copyright Marc Cousin, Dalibo
use Getopt::Long;
use Data::Dumper;
use Cwd;
use Encode::Guess;
use Carp;
use strict;
# Global objects definition structure: we need it to store all seen tables, detect which ones have LOBS
# and if their PK is a simple integer (so we can parallelize readings on these tables in a special
# kettle transformation)
# $objects will contain the parsed structure of the SQL Server dump
# If you have to hack and want to understand its structure, just uncomment the call to Dumper() in the code
# There is just too many things in it, and it evolves all the time
my $objects;
# These are global variables, from configuration file or command line arguments
our ($sd,$sh,$sp,$su,$sw,$pd,$ph,$pp,$pu,$pw);# Connection args
our $conf_file;
our $filename;# Filename passed as arg
our $case_insensitive=0; # Passed as arg: was SQL Server installation case insensitive ? PostgreSQL can't ignore accents anyway
# If yes, we will generate citext with CHECK constraints, that's the best we can do
our $norelabel_dbo=0; # Passed as arg: should we convert DBO to public ?
our $convert_numeric_to_int=0; # Should we convert numerics to int when possible ? (numeric (4,0) could be converted an int, for instance)
our $kettle;
our $before_file;
our $after_file;
our $unsure_file;
my $template; # These two variables are loaded in the BEGIN block at the end of this file (they are very big
my $template_lob; # putting them there won't pollute the code as much)
my ($job_header,$job_middle,$job_footer); # These are used to create the static parts of the job
my ($job_entry,$job_hop); # These are used to create the dynamic parts of the job (XML file)
# Opens the configuration file
# Sets $sd $sh $sp $su $sw $pd $ph $pp $pu $pw when they are not set in the command line already
# Also gets kettle parameters...
sub parse_conf_file
{
# Correspondance between conf_file parameter and program variable
# This is also used as the list of accepted parameters in the configuration file
my %parameters=( 'sql server database' => 'sd',
'sql server host' => 'sh',
'sql server port' => 'sp',
'sql server username' => 'su',
'sql server password' => 'sw',
'postgresql database' => 'pd',
'postgresql host' => 'ph',
'postgresql port' => 'pp',
'postgresql username' => 'pu',
'postgresql password' => 'pw',
'kettle directory' => 'kettle',
'before file' => 'before_file',
'after file' => 'after_file',
'unsure file' => 'unsure_file',
'sql server dump filename' => 'filename',
'case insensitive' => 'case_insensitive',
'no relabel dbo' => 'norelabel_dbo',
'convert numeric to int' => 'convert_numeric_to_int',
);
# Open the conf file or die
open CONF,$conf_file or die "Cannot open $conf_file";
while (my $line = <CONF>)
{
$line =~ s/#.*//; # Remove comments
$line =~ s/\s+=\s+//; # Remove whitespaces around the =
$line =~ s/\s+$//; # Remove trailing whitespaces
next if ($line =~ /^$/); # Empty line after comments have been removed
$line =~ /^(.*)=(.*)$/ or die "Cannot parse $line from $conf_file";
my ($param,$value)=($1,$2);
no strict 'refs'; # Using references by name, temporarily
unless (defined $parameters{$param})
{
die "Cannot understand parameter $param in $conf_file";
}
my $param_name=$parameters{$param};
if (defined $$param_name)
{
next; # Parameter overriden in command line
}
$$param_name=$value;
use strict 'refs';
}
close CONF;
}
# Converts numeric(4,0) and similar to int, bigint, smallint
sub convert_numeric_to_int
{
my ($qual)=@_;
croak "not a good qualifier $qual" unless ($qual =~ /^(\d+),\s*(\d+)$/);
my $precision=$1;
my $scale=$2;
croak "scale should be 0\n" unless ($scale eq '0');
return 'smallint' if ($precision<=4);
return 'integer' if ($precision<=9);
return 'bigint' if ($precision<=18);
return 'numeric($qual)';
}
# These are the no-brainer conversions
# There is still a special case for text types and case insensitivity (see convert_type) though
my %types=('int'=>'int',
'nvarchar'=>'varchar',
'nchar'=>'char',
'varchar'=>'varchar',
'char'=>'char',
'smallint'=>'smallint',
'tinyint'=>'smallint',
'datetime'=>'timestamp',
'smalldatetime'=>'timestamp',
'char'=>'char',
'image'=>'bytea',
'text'=>'text',
'bigint'=>'bigint',
'timestamp'=>'timestamp',
'decimal'=>'numeric',
'binary'=>'bytea',
'varbinary'=>'bytea',
);
# Types with no qualifier, and no point in putting one
my %unqual=('bytea'=>1);
# This function uses the two static lists above, plus domains and citext types that
# may have been created during parsing, to convert mssql's types to pgsql's
sub convert_type
{
my ($sqlstype,$sqlqual,$colname,$tablename,$typname,$schemaname)=@_;
my $rettype;
if (defined $types{$sqlstype})
{
if ((defined $sqlqual and defined ($unqual{$types{$sqlstype}})) or not defined $sqlqual)
{
# This is one of the few types that have to be unqualified (binary type)
$rettype= $types{$sqlstype};
}
elsif (defined $sqlqual)
{
$rettype= ($types{$sqlstype}."($sqlqual)");
}
}
# A few special cases
elsif ($sqlstype eq 'bit' and not defined $sqlqual)
{
$rettype= "boolean";
}
elsif ($sqlstype eq 'ntext' and not defined $sqlqual)
{
$rettype= "text";
}
elsif ($sqlstype eq 'numeric')
{
# Numeric is a special case:
# No qualifier. We have to use numeric
return 'numeric' unless ($sqlqual);
return "numeric($sqlqual)" unless ($sqlqual =~ /\d+,\s*0/); # If the qualifier is not x,0
return "numeric($sqlqual)" unless ($convert_numeric_to_int); # If we have not activated conversion
return convert_numeric_to_int($sqlqual); # We got there: convert !
}
else
{
print "Types: " , Dumper(\%types);
croak "Cannot determine the PostgreSQL's datatype corresponding to $sqlstype. This is a bug\n";
}
# We special case when type is varchar, to be case insensitive
if ($sqlstype =~ /text|varchar/ and $case_insensitive)
{
$rettype="citext";
# Do we have a SQL qualifier ? (we'll have to do check constraints then)
if ($sqlqual)
{
# Check we have a table name and a colname, or a typname
if (defined $colname and defined $tablename) # We are called from a CREATE TABLE, we have to add a check constraint
{
my $constraint;
$constraint->{TYPE}='CHECK_CITEXT';
$constraint->{TABLE}=$tablename;
$constraint->{TEXT}="char_length($colname) <= $sqlqual";
push @{$objects->{$schemaname}->{TABLES}->{$tablename}->{CONSTRAINTS}},($constraint);
}
elsif (defined $typname) # We are called from a CREATE TYPE, which will be converted to a CREATE DOMAIN
{
$rettype="citext CHECK(char_length(value)<=$sqlqual)";
}
else
{
die "Called in a case sensitive, trying to generate a check constraint, failed. This is a bug!";
}
}
}
return $rettype;
}
# This gives the next column position for a table
# It is used when we receive alter tables in the sql server dump
# These tables are added at the end of the table, in %objects
sub next_col_pos
{
my ($schema,$table)=@_;
if (defined $objects->{$schema}->{TABlES}->{$table}->{COLS})
{
my $max=0;
foreach my $col(values (%{$objects->{$schema}->{TABlES}->{$table}->{COLS}}))
{
if ($col->{POS} > $max)
{
$max=$col->{POS};
}
}
return $max+1;
}
else
{
die "We tried to add a column to an unknown table";
}
}
# This relabels the string if it is dbo and we want to relabel it to public
sub dboreplace
{
my ($schema)=@_;
return $schema if ($schema ne 'dbo');
return 'public' unless ($norelabel_dbo);
return 'dbo';
}
# Test if we are on windows. We will have to convert / to \ in the XML files
sub is_windows
{
if ($^O =~ /win/i)
{
return 1;
}
return 0;
}
# Die if kettle is not set up correctly
sub kettle_die
{
my ($file)=@_;
die "You have to set up KETTLE_EMPTY_STRING_DIFFERS_FROM_NULL=Y in $file.\nIf this file doesn't exist yet, start spoon from the kettle directory once.";
}
# This sub checks ~/.kettle/kettle.properties to be sure
# KETTLE_EMPTY_STRING_DIFFERS_FROM_NULL=Y is in place
# We die if not
sub check_kettle_properties
{
my $ok=0;
my $file;
if (!is_windows())
{
$file= $ENV{'HOME'}.'/.kettle/kettle.properties';
}
else
{
$file= $ENV{'USERPROFILE'}.'/.kettle/kettle.properties';
}
open FILE, $file or kettle_die($file);
while (<FILE>)
{
next unless (/KETTLE_EMPTY_STRING_DIFFERS_FROM_NULL\s*=\s*Y/);
$ok=1;
}
close FILE;
if (not $ok)
{
kettle_die($file);
}
return 0;
}
# Usage, obviously. Has to be kept in sync with new command line options
sub usage
{
print "$0 [-k kettle_output_directory] -b before_file -a after_file -u unsure_file -f sql_server_schema_file[-h] [-i]\n";
print "\nExpects a SQL Server SQL structure dump as -f (preferably unicode)\n";
print "-i tells $0 to create a case-insensitive PostgreSQL schema\n";
print "-nr tells $0 not to convert the dbo schema to public. dbo will stay dbo\n";
print "-num tells $0 to convert numeric xxx,0 to int, bigint, etc. Will not keep numeric scale and precision for the converted\n";
print "before_file contains the structure\n";
print "after_file contains index, constraints\n";
print "unsure_file contains things we cannot guarantee will work, such as views\n";
print "\n";
print "If you are generating for kettle, you'll need to provide connection information\n";
print "for connecting to both databases:\n";
print "-sd: sqlserver database\n";
print "-sh: sqlserver host\n";
print "-sp: sqlserver port\n";
print "-su: sqlserver username\n";
print "-sw: sqlserver password\n";
print "-pd: postgresql database\n";
print "-ph: postgresql host\n";
print "-pp: postgresql port\n";
print "-pu: postgresql username\n";
print "-pw: postgresql password\n";
}
# This function generates kettle transformations, and a kettle job running all these
# transformations sequentially, for all the tables, in all the schemas, in sql server's dump
sub generate_kettle
{
my ($dir)=@_;
# first, create the kettle directory
unless (-d $dir)
{
mkdir ($dir) or die "Cannot create $dir";
}
# For each table in each schema in $objects, we generate a kettle file in the directory
foreach my $schema ( sort keys %{$objects})
{
my $refschema=$objects->{$schema};
my $targetschema=dboreplace($schema);
foreach my $table (sort keys %{$refschema->{TABLES}})
{
# First, does this table have LOBs ? The template depends on this
my $newtemplate;
if ($refschema->{TABLES}->{$table}->{haslobs})
{
$newtemplate=$template_lob;
# Is the PK int and on only one column ?
# If yes, we can use several threads in kettle to read this table to
# improve performance
if (defined ($refschema->{TABLES}->{$table}->{PK}->{COLS}) and scalar(@{$refschema->{TABLES}->{$table}->{PK}->{COLS}})==1
and
($refschema->{TABLES}->{$table}->{COLS}->{($refschema->{TABLES}->{$table}->{PK}->{COLS}->[0])}->{TYPE} =~ /int$/)
)
{
my $wherefilter='WHERE ' . $refschema->{TABLES}->{$table}->{PK}->{COLS}->[0]
. '% ${Internal.Step.Unique.Count} = ${Internal.Step.Unique.Number}';
$newtemplate =~ s/__sqlserver_where_filter__/$wherefilter/;
$newtemplate =~ s/__sqlserver_copies__/4/g;
}
else
# No way to do this optimization. Use standard template
{
$newtemplate =~ s/__sqlserver_where_filter__//;
$newtemplate =~ s/__sqlserver_copies__/1/g
}
}
else
{
$newtemplate=$template;
}
# Substitute every connection placeholder with the real value
$newtemplate =~ s/__sqlserver_database__/$sd/g;
$newtemplate =~ s/__sqlserver_host__/$sh/g;
$newtemplate =~ s/__sqlserver_port__/$sp/g;
$newtemplate =~ s/__sqlserver_username__/$su/g;
$newtemplate =~ s/__sqlserver_password__/$sw/g;
$newtemplate =~ s/__postgres_database__/$pd/g;
$newtemplate =~ s/__postgres_host__/$ph/g;
$newtemplate =~ s/__postgres_port__/$pp/g;
$newtemplate =~ s/__postgres_username__/$pu/g;
$newtemplate =~ s/__postgres_password__/$pw/g;
$newtemplate =~ s/__sqlserver_table_name__/$schema.$table/g;
$newtemplate =~ s/__postgres_table_name__/$table/g;
$newtemplate =~ s/__postgres_schema_name__/$targetschema/g;
# Store this new transformation into its file
open FILE, ">$dir/$schema-$table.ktr" or die "Cannot write to $dir/$schema-$table.ktr";
print FILE $newtemplate;
close FILE;
}
}
# All transformations are done
# We have to create a job to launch everything in one go
open FILE, ">$dir/migration.kjb" or die "Cannot write to $dir/migration.kjb";
my $real_dir=getcwd;
my $entries='';
my $hops='';
my $prev_node='START';
my $cur_vert_pos=100; # Not that useful, it's just not to be ugly if someone wanted to open
# the job with spoon (kettle's gui) and work on it graphically
# We sort only so that it will be easier to find a transformation in the job if one needed to
# edit it. It's also easier to track progress if tables are sorted alphabetically
foreach my $schema(sort keys %{$objects})
{
my $refschema=$objects->{$schema};
foreach my $table (sort {lc($a) cmp lc($b)}keys %{$refschema->{TABLES}})
{
my $tmp_entry=$job_entry;
# We build the entries with regexp substitutions. The tablename contains the schema
$tmp_entry =~ s/__table_name__/${schema}_${table}/;
# Filename to use. We need the full path to the transformations
my $filename;
if ( $dir =~ /^(\\|\/)/) # Absolute path
{
$filename = $dir . '/' . $schema . '-' . $table . '.ktr';
}
else
{
$filename = $real_dir . '/' . $dir . '/' . $schema . '-' . $table . '.ktr';
}
# Different for windows and linux, obviously: we change / to \ for windows
unless (is_windows())
{
$filename =~ s/\////g;
}
else
{
$filename =~ s/\//\\/g;
}
$tmp_entry =~ s/__file_name__/$filename/;
$tmp_entry =~ s/__y_loc__/$cur_vert_pos/;
$entries.=$tmp_entry;
# We build the hop with the regexp too
my $tmp_hop=$job_hop;
$tmp_hop =~ s/__table_1__/$prev_node/;
$tmp_hop =~ s/__table_2__/${schema}_${table}/;
if ($prev_node eq 'START')
{
# Specific to the start node. It has to be unconditional
$tmp_hop =~ s/<unconditional>N<\/unconditional>/<unconditional>Y<\/unconditional>/;
}
$hops.=$tmp_hop;
# We increment everything for next loop
$prev_node="${schema}_${table}"; # For the next hop
$cur_vert_pos+=80; # To be pretty in spoon
}
}
print FILE $job_header;
print FILE $entries;
print FILE $job_middle;
print FILE $hops;
print FILE $job_footer;
close FILE;
}
# sql server's dump may contain multiline C style comments (/* */)
# This sub reads a line and cleans it up, removing comments, \r, exec sp_executesql,...
# It takes into account the status (in or out of comment) of the previous line, hence
# the scoped $in_comment
{
my $in_comment=0;
sub read_and_clean
{
my ($fd)=@_;
my $line=<$fd>;
return undef if (not defined $line);
$line =~ s/\r//g; # Remove \r from windows output
$line =~ s/EXEC(ute)?\s*(dbo|sys)\.sp_executesql( \@statement =)? N'//i; # Remove executesql… it's a bit weird in the SQL Server's dump
# If we are not in comment, we look for /*
# If we are in comment, we look for */, and we remove everything until */
if (not $in_comment)
{
# We first remove all one-line only comments (there may be several on this line)
$line =~ s/\/\*.*?\*\///g;
# Is there a comment left ?
if ($line =~ /\/\*/)
{
$in_comment=1;
$line =~ s/\/\*.*//; # Remove everything after the comment
}
}
else
{
# We do the reverse: keep only what is not commented
$line =~ s/\*\/(.*?)\/\*/$1/g;
# Is there an uncomment left ?
if ($line =~ /\*\//)
{
$in_comment=0;
$line =~ s/.*\*\///; # Remove everything before the uncomment
}
else
{
# There is no uncomment. The line should be empty
$line = "\n";
}
}
return $line;
}
}
# Reads the dump passed as -f
# Generates the $object structure
# That's THE MAIN FUNCTION
sub parse_dump
{
# Open the input file or die. This first pass is to detect encoding, and open it correctly afterwards
my $data;
my $file;
open $file,"<$filename" or die "Cannot open $filename";
while (my $line=<$file>)
{
$data.=$line;
}
close $file;
# We now ask guess...
my $decoder=guess_encoding($data, qw/iso8859-15/);
die $decoder unless ref($decoder);
# If we got to here, it means we have found the right decoder
# or at least, perl thinks it has :)
open $file,"<:encoding(".$decoder->name.")",$filename or die "Cannot open $filename";
# Parsing loop variables
my $create_table=0; # Are we in a create table statement ?
my $tablename=''; # If yes, what's the table name ?
my $schemaname=''; # If yes, what's the schema name ?
my $colnumber=0; # Column number (just to put the commas in the right places) ?
# Tagged because sql statements are often multi-line, so there are inner loops in some conditions
MAIN: while (my $line=read_and_clean($file))
{
# Create table, obviously. There will be other lines below for the rest of the table definition
if ($line =~ /^CREATE TABLE \[(.*)\]\.\[(.*)\]\(/)
{
$create_table=1; # We are now inside a create table
$schemaname=$1;
$tablename=$2;
$colnumber=0;
$objects->{$schemaname}->{TABLES}->{$tablename}->{haslobs}=0;
}
# Here is a col definition. We should be inside a create table
elsif ($line =~ /^\t\[(.*)\] (?:\[(.*)\]\.)?\[(.*)\](\(.+?\))?( IDENTITY\(\d+,\s*\d+\))? (NOT NULL|NULL)(,)?/)
{
if ($create_table) # We are inside a create table, this is a column definition
{
$colnumber++;
my $colname=$1;
my $coltypeschema=$2;
my $coltype=$3;
if (defined $coltypeschema)
{
# The datatype is a user defined datatype
# It has already been declared before. We just need to find it
$coltype=$coltypeschema . '.' . $coltype;
}
my $colqual=$4;
my $isidentity=$5;
my $colisnull=$6;
if ($colqual)
{
if ($colqual eq '(max)')
{
$colqual=undef; # max in sql server is the same as putting no colqual in pg
}
else
{
# We need the number (or 2 numbers) in this qual
$colqual=~ /\((\d+(?:,\s*\d+)?)\)/ or die "Cannot parse colqual <$colqual>";
$colqual= "$1";
}
}
my $newtype=convert_type($coltype,$colqual,$colname,$tablename,undef,$schemaname);
# If it is an identity, we'll map to serial/bigserial (create a sequence, then link it
# to the column)
if ($isidentity)
{
# We have an identity field. We remember the default value and
# initialize the sequence correctly in the after script
$isidentity=~ /IDENTITY\((\d+),\s*(\d+)\)/ or die "Cannot understand <$isidentity>";
my $startseq=$1;
my $stepseq=$2;
my $seqname= lc("${tablename}_${colname}_seq");
$objects->{$schemaname}->{TABLES}->{$tablename}->{COLS}->{$colname}->{DEFAULT}=
"nextval('" . dboreplace(${schemaname}) . '.' . ${seqname}. "')";
$objects->{$schemaname}->{SEQUENCES}->{$seqname}->{START}=$startseq;
$objects->{$schemaname}->{SEQUENCES}->{$seqname}->{STEP}=$stepseq;
$objects->{$schemaname}->{SEQUENCES}->{$seqname}->{OWNERTABLE}=$tablename . "." . $colname;
$objects->{$schemaname}->{SEQUENCES}->{$seqname}->{OWNERSCHEMA}=$schemaname;
}
# If there is a bytea generated, this table will contain a blob:
# use a special kettle transformation for it if generating kettle
# (see generate_kettle() )
if ($newtype eq 'bytea' or $coltype eq 'ntext') # Ntext is very slow, stored out of page
{
$objects->{$schemaname}->{'TABLES'}->{$tablename}->{haslobs}=1;
}
$objects->{$schemaname}->{'TABLES'}->{$tablename}->{COLS}->{$colname}->{POS}=$colnumber;
$objects->{$schemaname}->{'TABLES'}->{$tablename}->{COLS}->{$colname}->{TYPE}=$newtype;
if ($colisnull eq 'NOT NULL')
{
$objects->{$schemaname}->{'TABLES'}->{$tablename}->{COLS}->{$colname}->{NOT_NULL}=1;
}
else
{
$objects->{$schemaname}->{'TABLES'}->{$tablename}->{COLS}->{$colname}->{NOT_NULL}=0;
}
}
else
{
die "I don't understand $line. This is a bug";
}
}
elsif ($line =~ /^(?: CONSTRAINT \[(.*)\] )?PRIMARY KEY (?:NON)?CLUSTERED/)
{
# This is not forbidden by SQL, of course. I just never saw this in a sql server dump,
# so it should be an error for now (it will be syntaxically different if outside a table anyhow)
die "PK defined outside a table\n: $line" unless ($create_table);
my $constraint; # We put everything inside this hashref, we'll push it into the constraint list later
$constraint->{TYPE}='PK';
if (defined $1)
{
$constraint->{NAME}=$1;
}
# Here is the PK. We read the following lines until the end of the constraint
while (my $pk=read_and_clean($file))
{
# Exit when read a line beginning with ). The constraint is complete. We store it and go back to main loop
if ($pk =~ /^\)/)
{
push @{$objects->{$schemaname}->{TABLES}->{$tablename}->{CONSTRAINTS}},($constraint);
# We also directly put the constraint reference in a direct path (for ease of use in generate_kettle)
$objects->{$schemaname}->{TABLES}->{$tablename}->{PK}=$constraint;
next MAIN;
}
if ($pk =~ /^\t\[(.*)\] (ASC|DESC)(,?)/)
{
push @{$constraint->{COLS}},($1);
}
}
}
elsif ($line =~ /^\s*(?:CONSTRAINT \[(.*)\] )?UNIQUE/)
{
# This is not forbidden by SQL, of course. I just never saw this in a sql server dump,
# so it should be an error for now (it will be syntaxically different if outside a table anyhow)
die "Unique key defined outside a table\n: $line" unless ($create_table);
my $constraint; # We put everything inside this hashref, we'll push it into the constraint list later
$constraint->{TYPE}='UNIQUE';
if (defined $1)
{
$constraint->{NAME}=$1;
}
# Unique key definition. We read following lines until the end of the constraint
while (my $uk=read_and_clean($file))
{
# Exit when read a line beginning with ). The constraint is complete
if ($uk =~ /^\)/)
{
push @{$objects->{$schemaname}->{'TABLES'}->{$tablename}->{CONSTRAINTS}},($constraint);
next MAIN;
}
if ($uk =~ /^\t\[(.*)\] (ASC|DESC)(,?)/)
{
push @{$constraint->{COLS}},($1);
}
}
}
elsif ($line =~ /^\) ON \[PRIMARY\]/)
{
# End of the table
$create_table=0;
$tablename='';
}
################################################################
# From HERE, these SQL commands are not linked to a create table
################################################################
elsif ($line =~ /CREATE SCHEMA \[(.*)\] AUTHORIZATION \[.*\]/)
{
$objects->{$1}=undef; # Nothing to add here, we create the schema, and put undef in it for now
}
elsif ($line =~ /CREATE\s+PROC(?:EDURE)?\s+\[.*\]\.\[(.*)\]/i)
{
print STDERR "Procedure $1 ignored\n";
# We have to find next GO to know we are out of the procedure
while (my $contline=read_and_clean($file))
{
next MAIN if ($contline =~ /^GO$/);
}
}
elsif ($line =~ /CREATE\s+FUNCTION\s+\[.*\]\.\[(.*)\]/i)
{
print STDERR "Function $1 ignored\n";
# We have to find next GO to know we are out of the procedure
while (my $contline=read_and_clean($file))
{
next MAIN if ($contline =~ /^GO$/);
}
}
elsif ($line =~ /CREATE\s+TRIGGER\s+\[(.*)\]/i)
{
print STDERR "Trigger $1 ignored\n";
# We have to find next GO to know we are out of the procedure
while (my $contline=read_and_clean($file))
{
next MAIN if ($contline =~ /^GO$/);
}
}
# Now we parse the create view. It is multi-line, so the code looks like like create table: we parse everything until a line
# containing only a single quote (end of the dbo.sp_executesql)
# The problem is that SQL Server seems to be spitting the original query used to create the view, not a normalized version
# of it, as PostgreSQL does. So we capture the query, and hope it works for now.
elsif ($line =~ /^\s*(create\s*view)\s*(?:\[(\S+)\])?\.\[(.*?)\]\s*(.*)$/i)
{
my $viewname=$3;
my $schemaname;
if (defined $2)
{
$schemaname=$2;
}
else
{
$schemaname='dbo';
}
my $sql=$1 . ' ' . $3 . ' ' . $4 . "\n";
while (my $line_cont=read_and_clean($file))
{
if ($line_cont =~ /^\s*'\s*$/)
{
# The view definition is complete.
# We get rid of dbo. schemas
$sql =~ s/dbo\.//g; # We put this in the current schema
# Views will be stored without the full schema in them. We will
# have to generate the schema in the output file
$objects->{$schemaname}->{'VIEWS'}->{$viewname}->{SQL}=$sql;
next MAIN;
}
$sql.=$line_cont;
}
}
# I only have seen types with added constraints ( create type foo varchar(50)) for now
# These are domains with PostgreSQL
elsif ($line =~ /^CREATE TYPE \[(.*?)\]\.\[(.*?)\] FROM \[(.*?)](?:\((\d+(?:,\s*\d+)?)?\))?/)
{
# Dependency between types is not done for now. If the problem arises, it should be added
my ($schema,$type,$origtype,$quals)=($1,$2,$3,$4);
my $newtype=convert_type($origtype,$quals,undef,undef,$type,$schema);
$objects->{$schema}->{DOMAINS}->{$type}=$newtype;
# We add them to known data types, as they probably will be used in table definitions
# but they point to themselves, with the schema corrected: we want them substituted by themselves
$types{$schema . '.' . $type}=dboreplace($schema) . '.' . $type; # We store the schema with it
}
elsif ($line =~ /^CREATE (UNIQUE )?NONCLUSTERED INDEX \[(.*)\] ON \[(.*)\]\.\[(.*)\]/)
{
# Index creation. Index are namespaced per table in SQL Server, not in PostgreSQL
# In PostgreSQL they are in the same namespace as the tables, and in the same
# schema as the table they are attached to
# So we store them in $objects, attached to the table
# Conflicts will be sorted by resolve_name_conflicts() later
my $isunique=$1;
my $idxname=$2;
my $schemaname=$3;
my $tablename=$4;
if ($isunique)
{
$objects->{$schemaname}->{TABLES}->{$tablename}->{INDEXES}->{$idxname}->{UNIQUE}=1;
}
else
{
$objects->{$schemaname}->{TABLES}->{$tablename}->{INDEXES}->{$idxname}->{UNIQUE}=0;
}
while (my $idx=read_and_clean($file))
{
# Exit when read a line beginning with ). The index is complete
if ($idx =~ /^\)/)
{
next MAIN;
}
next if ($idx =~ /^\(/); # Begin of the columns declaration
if ($idx =~ /\t\[(.*)\] (ASC|DESC)(,)?/)
{
if (defined $2)
{
push @{$objects->{$schemaname}->{TABLES}->{$tablename}->{INDEXES}->{$idxname}->{COLS}}, ("$1 $2");
}
else
{
push @{$objects->{$schemaname}->{TABLES}->{$tablename}->{INDEXES}->{$idxname}->{COLS}}, ("$1");
}
}
}
}
# Added table columns… this seems to appear in SQL Server when some columns have ANSI padding, and some not.
# PG follows ANSI, that is not an option. The end of the regexp is pasted from the create table
elsif ($line =~ /^ALTER TABLE \[.*\]\.\[(.*)\] ADD \[(.*)\] (?:\[.*\]\.)?\[(.*)\](\(.+?\))?( .*\(\d+,\s*\d+\))? (NOT NULL|NULL)$/)
{
# For now I don't know what to do with them. So die
die "$line: not understood. This is a bug";
}
# Table constraints
# Primary key. Multiline
elsif ($line =~ /^ALTER TABLE \[.*\]\.\[(.*)\] ADD\s*(?:CONSTRAINT \[(.*)\])? PRIMARY KEY (?:CLUSTERED)?/)
{
# Never seen one for now. The code is there though, in case, with a die for now
die "$line: not understood. This is a bug";
while (my $contline=read_and_clean($file))
{
next MAIN if ($contline =~ /^GO/);
}
}
# Default values. numeric, then text, then bit
elsif ($line =~ /^ALTER TABLE \[(.*)\]\.\[(.*)\] ADD\s*(?:CONSTRAINT \[.*\])?\s*DEFAULT \(\(((?:-)?\d+)\)\) FOR \[(.*)\]/)
{
$objects->{$1}->{TABLES}->{$2}->{COLS}->{$4}->{DEFAULT}=$3;
# Default value, for a numeric (yes sql server puts it in another pair of parenthesis, don't know why)
}
elsif ($line =~ /^ALTER TABLE \[(.*)\]\.\[(.*)\] ADD\s*(?:CONSTRAINT \[.*\])?\s*DEFAULT \('(.*)'\) FOR \[(.*)\]/)
{
# Default text value, text, between commas
$objects->{$1}->{TABLES}->{$2}->{COLS}->{$4}->{DEFAULT}="'$3'";
}
elsif ($line =~ /^ALTER TABLE \[(.*)\]\.\[(.*)\] ADD\s*(?:CONSTRAINT \[.*\])?\s*DEFAULT \((\d)\) FOR \[(.*)\]/)
{
# Weird one: for bit type, there is no supplementary parenthesis... for now, let's say this is a bit type, and
# convert to true/false
if ($3 eq '0')
{
$objects->{$1}->{TABLES}->{$2}->{COLS}->{$4}->{DEFAULT}='false';
}
elsif ($3 eq '1')
{
$objects->{$1}->{TABLES}->{$2}->{COLS}->{$4}->{DEFAULT}='true';
}
else
{
die "not expected for a boolean: $line $. This is a bug"; # Get an error if the true/false hypothesis is wrong
}
}
# FK constraint. It's multi line, we have to look for references, and what to do on update, detele, etc (I have only seen delete cascade for now)
elsif ($line =~ /^ALTER TABLE \[(.*)\]\.\[(.*)\]\s+WITH (?:NO)?CHECK ADD\s+CONSTRAINT \[(.*)\] FOREIGN KEY\((.*?)\)/)
{
# This is a FK definition. We have the foreign table definition in next line.
my $constraint;
my $table=$2;
my $schema=$1;
$constraint->{TYPE}='FK';
$constraint->{LOCAL_COLS}=$4;
$constraint->{LOCAL_TABLE}=$2;
$constraint->{LOCAL_COLS} =~ s/\[|\]//g; # Remove brackets
while (my $fk = read_and_clean($file))
{
if ($fk =~ /^GO/)
{
push @{$objects->{$schema}->{'TABLES'}->{$table}->{CONSTRAINTS}},($constraint);
next MAIN;
}
elsif ($fk =~ /^REFERENCES \[(.*)\]\.\[(.*)\] \((.*?)\)/)
{
$constraint->{REMOTE_COLS}=$3;
$constraint->{REMOTE_TABLE}=$2;
$constraint->{REMOTE_SCHEMA}=$1;
$constraint->{REMOTE_COLS} =~ s/\[|\]//g; # Get rid of square brackets
}
elsif ($fk =~ /^ON DELETE CASCADE\s*$/)
{
$constraint->{ON_DEL_CASC}=1;
}
else
{
die "Cannot parse $fk $., in a FK. This is a bug";
}
}
}
# Check constraint. As it can be arbitrary code, we just get this code, and hope it will work on PG (it will be stored in a special script file)
elsif ($line =~ /ALTER TABLE \[(.*)\]\.\[(.*)\] WITH (?:NO)?CHECK ADD CONSTRAINT \[(.*)\] CHECK \(\((.*)\)\)/ )
{
# Check constraint. We'll do what we can, syntax may be different.
my $constraint;
my $table=$2;
my $constxt=$4;
my $schema=$1;
$constraint->{TABLE}=$table;
$constraint->{NAME}=$3;
$constraint->{TYPE}='CHECK';
$constxt =~ s/\[(\S+)\]/$1/g; # We remove the []. And hope this will parse
$constraint->{TEXT}=$constxt;
push @{$objects->{$schema}->{'TABLES'}->{$table}->{CONSTRAINTS}},($constraint);
}
# These are comments or extended attributes on objets. They can be multiline, so aggregate everything
# Until next GO command
# If fact in can be a lot of things. So we have to ignore things like MS_DiagramPaneCount
elsif ($line =~ /^EXEC sys.sp_addextendedproperty/)
{
my $sqlproperty=$line;
while (my $inline=read_and_clean($file))
{
last if ($inline =~ /^GO/);
$sqlproperty.=$inline
}
# We have all the extended property. Let's parse it.
# First step: what kind is it ? we are only interested in comments for now
$sqlproperty =~ /\@name=N'(.*?)'/ or die "Cannot find a name for this extended property: $sqlproperty";
my $propertyname=$1;
if ($propertyname =~ /^(MS_DiagramPaneCount|MS_DiagramPane1)$/)
{
# We don't dump these. They are graphical descriptions of the GUI
next;
}
elsif ($propertyname eq 'MS_Description')
{
# This is a comment. We parse it.
# Spaces are mostly random it seems, in SQL Server's dump code. So \s* everywhere :(
# There can be quotes inside a string. So (?<!')' matches only a ' not preceded by a '.
# I hope it will be sufficient (won't be if someone decides to end a comment with a quote)
$sqlproperty =~ /^EXEC sys.sp_addextendedproperty \@name=N'(.*?)'\s*,\s*\@value=N'(.*?)(?<!')'\s*,\s*\@level0type=N'(.*?)'\s*,\s*\@level0name=N'(.*?)'\s*(?:,\s*\@level1type=N'(.*?)'\s*,\s*\@level1name=N'(.*?)')\s*?(?:,\s*\@level2type=N'(.*?)'\s*,\s*\@level2name=N'(.*?)')?/s
or die "Could not parse $sqlproperty. This is a bug.";
my ($comment,$schema,$obj,$objname,$subobj,$subobjname)=($2,$4,$5,$6,$7,$8);
if ($obj eq 'TABLE' and not defined $subobj)
{
$objects->{$schema}->{TABLES}->{$objname}->{COMMENT}=$comment;
}
elsif ($obj eq 'VIEW' and not defined $subobj)
{
$objects->{$schema}->{VIEWS}->{$objname}->{COMMENT}=$comment;
}
elsif ($obj eq 'TABLE' and $subobj eq 'COLUMN')
{
$objects->{$schema}->{TABLES}->{$objname}->{COLS}->{$subobjname}->{COMMENT}=$comment;
}
else
{
die "Cannot understand this comment: $sqlproperty";
}
}
else
{
die "Don't know what to do with this extendedproperty: $sqlproperty";
}
}
# Ignore USE, GO, and things that have no meaning for postgresql
elsif ($line =~ /^USE\s|^GO\s*$|\/\*\*\*\*|^SET ANSI_NULLS ON|^SET QUOTED_IDENTIFIER|^SET ANSI_PADDING|CHECK CONSTRAINT|^BEGIN|^END/)
{
next;
}
elsif ($line =~ /^--/) # Comment
{
next;
}
# Don't know what it is. If you know, and it is worth converting, tell me :)
elsif ($line =~ /^EXEC .*bindrule/)
{
next;
}
# Ignore users and roles. Security models will probably be very different between the two databases
elsif ($line =~ /^CREATE (ROLE|USER)/)
{
next;
}
# Ignore existence tests… how could the object already exist anyway ? For now, only seen for views
elsif ($line =~ /^IF NOT EXISTS/)
{
next;
}
# Ignore EXEC dbo.sp_executesql, for now only seen for a create view. Views sql command aren't executed directly, don't know why
elsif ($line =~ /^EXEC dbo.sp_executesql/)
{
next;
}
# Still on views: there are empty lines, and C-style comments
elsif ($line =~ /^\s*$/)
{
next;
}
else
{
die "Line <$line> ($.) not understood. This is a bug";
}
}
close $file;
}
# Creates the SQL scripts from $object
# We generate alphabetically, to make things less random (this data comes from a hash)
sub generate_schema
{
my ($before_file,$after_file,$unsure_file)=@_;
# Open the output files (except kettle, we'll do that at the end)