File Coverage

blib/lib/VSGDR/MergeData.pm
Criterion Covered Total %
statement 35 171 20.4
branch 0 60 0.0
condition n/a
subroutine 12 25 48.0
pod 0 13 0.0
total 47 269 17.4


line stmt bran cond sub pod time code
1             package VSGDR::MergeData;
2            
3 1     1   69036 use strict;
  1         4  
  1         31  
4 1     1   6 use warnings;
  1         2  
  1         34  
5            
6 1     1   28 use 5.010;
  1         4  
7            
8 1     1   7 use List::Util qw(max);
  1         2  
  1         117  
9 1     1   530 use POSIX qw(strftime);
  1         7104  
  1         6  
10 1     1   1627 use Carp;
  1         3  
  1         49  
11 1     1   1762 use DBI;
  1         18397  
  1         84  
12 1     1   809 use Data::Dumper;
  1         7531  
  1         64  
13 1     1   507 use English;
  1         3744  
  1         6  
14             if ($OSNAME eq 'MSWin32') {require Win32} ;
15            
16             ##TODO 1. Fix multi-column primary/unique keys.
17             ##TODO 2. Check that non-key identity columns are handled correctly when they occur in the final position in the table.
18            
19             =head1 NAME
20            
21             VSGDR::MergeData - Static data script support package for SSDT post-deployment steps, Ded MedVed.
22            
23             =head1 VERSION
24            
25             Version 0.04
26            
27             =cut
28            
29             our $VERSION = '0.04';
30            
31            
32             sub databaseName {
33            
34 0     0 0   local $_ = undef ;
35            
36 0           my $dbh = shift ;
37            
38 0           my $sth2 = $dbh->prepare(databaseNameSQL());
39 0           my $rs = $sth2->execute();
40 0           my $res = $sth2->fetchall_arrayref() ;
41            
42 0           return $$res[0][0] ;
43            
44             }
45            
46             sub databaseNameSQL {
47            
48 0     0 0   return <<"EOF" ;
49            
50             select db_name()
51            
52             EOF
53            
54             }
55            
56             sub dependency {
57            
58 0     0 0   local $_ = undef ;
59            
60 0           my $dbh = shift ;
61            
62 0           my $sth2 = $dbh->prepare( dependencySQL());
63 0           my $rs = $sth2->execute();
64 0           my $res = $sth2->fetchall_arrayref() ;
65            
66 0 0         if ( scalar @{$res} ) { return $res ; } ;
  0            
  0            
67 0           return [] ;
68             }
69            
70            
71            
72             sub dependencySQL {
73            
74 0     0 0   return <<"EOF" ;
75             select distinct
76             tc2.TABLE_CATALOG as to_CATALOG
77             , tc2.TABLE_SCHEMA as to_SCHEMA
78             , tc2.TABLE_NAME as to_NAME
79             , tc1.TABLE_CATALOG as from_CATALOG
80             , tc1.TABLE_SCHEMA as from_SCHEMA
81             , tc1.TABLE_NAME as from_NAME
82             , rc.CONSTRAINT_NAME as to_CONSTRAINT
83             from INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc
84             join INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc1
85             on tc1.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
86             and tc1.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG
87             and tc1.CONSTRAINT_NAME = rc.CONSTRAINT_NAME
88             join INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc2
89             on tc2.CONSTRAINT_SCHEMA = rc.CONSTRAINT_SCHEMA
90             and tc2.CONSTRAINT_CATALOG = rc.CONSTRAINT_CATALOG
91             and tc2.CONSTRAINT_NAME = rc.UNIQUE_CONSTRAINT_NAME
92            
93             EOF
94            
95             }
96            
97            
98             sub generateScript {
99            
100 0     0 0   local $_ = undef;
101            
102 0           my $dbh = shift ;
103 0           my $src_schema = shift ;
104 0           my $src_table = shift ;
105 0           my $targ_schema = shift ;
106 0           my $targ_table = shift ;
107 0           my $script_type = shift ;
108            
109 0 0         croak "bad arg dbh" unless defined $dbh;
110 0 0         croak "bad arg source schema" unless defined $src_schema;
111 0 0         croak "bad arg source table" unless defined $src_table;
112 0 0         croak "bad arg target schema" unless defined $targ_schema;
113 0 0         croak "bad arg target table" unless defined $targ_table;
114            
115 0 0         $src_schema = substr $src_schema, 1, -1 if $src_schema =~ m/\A \[ .+ \] \Z /msix;
116 0 0         $src_table = substr $src_table, 1, -1 if $src_table =~ m/\A \[ .+ \] \Z /msix;
117 0 0         $targ_schema = substr $targ_schema, 1, -1 if $targ_schema =~ m/\A \[ .+ \] \Z /msix;
118 0 0         $targ_table = substr $targ_table, 1, -1 if $targ_table =~ m/\A \[ .+ \] \Z /msix;
119            
120 0           my $combinedSourceName = "${src_schema}.${src_table}";
121 0           my $quotedCombinedSourceName = "[${src_schema}].[${src_table}]";
122 0           my $combinedTargetName = "${targ_schema}.${targ_table}";
123 0           my $quotedCombinedTargetName = "[${targ_schema}].[${targ_table}]";
124            
125 0           my $database = databaseName($dbh);
126            
127 1     1   993 no warnings;
  1         2  
  1         108  
128 0 0         my $userName = $OSNAME eq 'MSWin32' ? eval('Win32::LoginName') : ${[getpwuid( $< )]}->[6]; $userName =~ s/,.*//;
  0            
  0            
129 1     1   8 use warnings;
  1         2  
  1         31  
130            
131 1     1   5 use warnings;
  1         2  
  1         1351  
132 0           my $date = strftime "%d/%m/%Y", localtime;
133            
134            
135            
136 0           my $hasId = has_idCols($dbh,$targ_schema,$targ_table) ;
137 0           my $idCol = undef ;
138 0 0         if ($hasId) {
139 0           $idCol = idCols($dbh,$targ_schema,$targ_table) ;
140             }
141            
142 0           my $ra_columns = columns($dbh,$targ_schema,$targ_table);
143 0           my $ra_pkcolumns = pkcolumns($dbh,$targ_schema,$targ_table);
144            
145 0 0         croak "${combinedTargetName} doesn't appear to be a valid table" unless scalar @{$ra_columns};
  0            
146            
147             #warn Dumper $ra_columns ;
148             #exit ;
149            
150             # croak 'No Primary Key defined' unless scalar @{$ra_pkcolumns};
151             # croak 'Unusable Primary Key defined' unless scalar @{$ra_pkcolumns} == 1;
152            
153 0 0         my @IsColumnNumeric = map { $_->[1] =~ m{char|text|date}i ? 0 : 1 ; } @{$ra_columns} ;
  0            
  0            
154            
155 0           my $primaryKeyCheckClause = "";
156 0           my @nonKeyColumns ;
157 0           foreach my $col (@{$ra_columns}) {
  0            
158 0 0         push @nonKeyColumns, $col unless grep {$_->[0] eq $col->[0] } @{$ra_pkcolumns} ;
  0            
  0            
159             }
160            
161            
162 0           my $onclause = do {local $" = " and "; "@{[map {\"tgt.$_->[0] = src.$_->[0]\"} @$ra_pkcolumns]}" };
  0            
  0            
  0            
  0            
163            
164 0           my $insertclause = "(" . do {local $" = ", "; "@{[map {\"[$_->[0]]\"} @$ra_columns]}" } . ")";
  0            
  0            
  0            
  0            
165 0           my $valuesclause = "(" . do {local $" = ", "; "@{[map {\"src.[$_->[0]]\"} @$ra_columns]}" } . ") ";
  0            
  0            
  0            
  0            
166            
167 0           my $fullUpdateClause = "" ;
168 0           my $exceptClause = "select " . do {local $" = ", "; "@{[map {\"tgt.[$_->[0]]\"} @nonKeyColumns]}" };
  0            
  0            
  0            
  0            
169 0           $exceptClause .= " except select " . do {local $" = ", "; "@{[map {\"src.[$_->[0]]\"} @nonKeyColumns]}" };
  0            
  0            
  0            
  0            
170            
171 0 0         if ( scalar @nonKeyColumns > 0 ) {
172 0           $fullUpdateClause ="when matched and exists (select * from (${exceptClause}) x )\n then update\n set " . do {local $" = "\n , "; "@{[map {\"tgt.[$_->[0]]\t\t= src.[$_->[0]]\"} @nonKeyColumns]}" };
  0            
  0            
  0            
  0            
173             }
174            
175 0           my $maxCol;
176            
177             #warn Dumper @maxWidth ;
178            
179            
180            
181 0           return <<"EOF";
182            
183             /****************************************************************************************
184             * Database: ${database}
185             * Author : ${userName}
186             * Date : ${date}
187             * Purpose : Merge statement usp for ${combinedTargetName}
188             *
189             *
190             * Version History
191             * ---------------
192             * 1.0.0 ${date} ${userName}
193             * Created.
194             ***************************************************************************************/
195            
196             create procedure [${src_schema}].[usp_merge_${src_table}]
197             as
198             begin
199            
200             set nocount on ;
201             set xact_abort on;
202            
203             begin try
204            
205             merge into
206             ${quotedCombinedTargetName} as tgt
207             using ${quotedCombinedSourceName} as src
208             on ${onclause}
209             when not matched by target then
210             insert ${insertclause}
211             values ${valuesclause}
212             ${fullUpdateClause}
213             when not matched by source then delete ;
214            
215             end try
216             begin catch
217            
218             if \@\@trancount > 0 or xact_state() = -1 begin
219             rollback;
220             throw;
221             end;
222            
223             end catch
224             end ;
225             go
226            
227            
228             EOF
229            
230             }
231            
232            
233             sub idCols {
234            
235 0     0 0   local $_ = undef ;
236            
237 0 0         my $dbh = shift or croak 'no dbh' ;
238 0 0         my $schema = shift or croak 'no schema' ;
239 0 0         my $table = shift or croak 'no table' ;
240            
241 0           my $sth2 = $dbh->prepare(idColsSQL());
242 0           my $rs = $sth2->execute($schema,$table);
243 0           my $res = $sth2->fetchall_arrayref() ;
244            
245 0           return $$res[0][0] ;
246            
247             }
248            
249             sub idColsSQL {
250            
251 0     0 0   return <<"EOF" ;
252            
253             select sc.name as ID_COL
254             FROM dbo.sysobjects so
255             join dbo.syscolumns sc
256             on so.id = sc.id
257             and sc.colstat & 1 = 1
258             where schema_name(so.uid) = ?
259             and so.name = ?
260            
261             EOF
262            
263             }
264            
265             sub has_idCols {
266            
267 0     0 0   local $_ = undef ;
268            
269 0 0         my $dbh = shift or croak 'no dbh' ;
270 0 0         my $schema = shift or croak 'no schema' ;
271 0 0         my $table = shift or croak 'no table' ;
272            
273 0           my $sth2 = $dbh->prepare(has_idColsSQL());
274 0           my $rs = $sth2->execute($schema,$table);
275 0           my $res = $sth2->fetchall_arrayref() ;
276            
277 0           return $$res[0][0] ;
278            
279             }
280            
281             sub has_idColsSQL {
282            
283 0     0 0   return <<"EOF" ;
284            
285             select 1 as ID_COL
286             FROM dbo.sysobjects so
287             where schema_name(so.uid) = ?
288             and so.name = ?
289             and exists (
290             select *
291             from dbo.syscolumns sc
292             where so.id = sc.id
293             and sc.colstat & 1 = 1
294             )
295             EOF
296            
297             }
298            
299            
300             sub pkcolumns {
301            
302 0     0 0   local $_ = undef ;
303            
304 0 0         my $dbh = shift or croak 'no dbh' ;
305 0 0         my $schema = shift or croak 'no schema' ;
306 0 0         my $table = shift or croak 'no table' ;
307            
308 0           my $sth2 = $dbh->prepare( pkcolumnsSQL());
309 0           my $rs = $sth2->execute($schema,$table,$schema,$table);
310 0           my $res = $sth2->fetchall_arrayref() ;
311            
312 0 0         if ( scalar @{$res} ) { return $res ; } ;
  0            
  0            
313 0           return [] ;
314             }
315            
316            
317            
318             sub pkcolumnsSQL {
319            
320 0     0 0   return <<"EOF" ;
321            
322             ; with ranking as (
323             select CONSTRAINT_SCHEMA, CONSTRAINT_NAME
324             , row_number() over (order by case when tc.CONSTRAINT_TYPE = 'PRIMARY KEY' then 1 else 2 end, CONSTRAINT_NAME ) as rn
325             from INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc
326             where tc.CONSTRAINT_TYPE in( 'PRIMARY KEY','UNIQUE' )
327             and tc.TABLE_SCHEMA = ?
328             and tc.TABLE_NAME = ?
329             )
330             select COLUMN_NAME
331             from INFORMATION_SCHEMA.TABLE_CONSTRAINTS tc
332             join INFORMATION_SCHEMA.KEY_COLUMN_USAGE kcu
333             on tc.TABLE_CATALOG = kcu.TABLE_CATALOG
334             and tc.TABLE_SCHEMA = kcu.TABLE_SCHEMA
335             and tc.TABLE_NAME = kcu.TABLE_NAME
336             and tc.CONSTRAINT_NAME = kcu.CONSTRAINT_NAME
337             join ranking rk
338             on tc.CONSTRAINT_SCHEMA = rk.CONSTRAINT_SCHEMA
339             and tc.CONSTRAINT_NAME = rk.CONSTRAINT_NAME
340             where tc.CONSTRAINT_TYPE in( 'PRIMARY KEY','UNIQUE' )
341             and tc.TABLE_SCHEMA = ?
342             and tc.TABLE_NAME = ?
343             and rn = 1
344             order by
345             ORDINAL_POSITION
346            
347             EOF
348            
349             }
350            
351            
352             sub columns {
353            
354 0     0 0   local $_ = undef ;
355            
356 0 0         my $dbh = shift or croak 'no dbh' ;
357 0 0         my $schema = shift or croak 'no schema' ;
358 0 0         my $table = shift or croak 'no table' ;
359            
360 0           my $sth2 = $dbh->prepare( columnsSQL());
361 0           my $rs = $sth2->execute($schema,$table,$schema,$table);
362 0           my $res = $sth2->fetchall_arrayref() ;
363            
364 0 0         if ( scalar @{$res} ) { return $res ; } ;
  0            
  0            
365 0           return [] ;
366             }
367            
368            
369            
370             sub columnsSQL {
371            
372 0     0 0   return <<"EOF" ;
373             select Column_name
374             , data_type
375             , case when character_maximum_length is not null then '('+ case when character_maximum_length = -1 then 'max' else cast(character_maximum_length as varchar(10)) end+')' else '' end
376             as datasize
377             , case when lower(Data_type) = 'float'
378             then '('+cast(Numeric_precision as varchar(10))+')'
379             when lower(Data_type) not like '%int%' and Numeric_precision is not null
380             then '('+cast(Numeric_precision as varchar(10))+','+cast(Numeric_scale as varchar(10))+')'
381             else ''
382             end
383             as dataprecision
384             , case when DATABASEPROPERTYEX(db_name(), 'Collation') != collation_name then 'collate ' + collation_name else '' end
385             as collation
386             , case when LOWER(IS_NULLABLE) = 'no' then 'not null' else 'null' end
387             as datanullabity
388             from INFORMATION_SCHEMA.COLUMNS
389             where 1=1
390             and TABLE_SCHEMA = ?
391             and TABLE_NAME = ?
392             and COLUMNPROPERTY(object_id(?+'.'+?) , COLUMN_NAME,'IsComputed') != 1
393             EOF
394            
395             }
396            
397            
398            
399            
400            
401            
402             __DATA__