773 lines
29 KiB
PL/PgSQL
773 lines
29 KiB
PL/PgSQL
--select * from dropall('migrations_read','meta');
|
|
CREATE OR REPLACE FUNCTION meta.migration_read(
|
|
p_id_migration_model integer default null
|
|
,OUT p_retval integer
|
|
,OUT p_errmsg text
|
|
,OUT p_info jsonb
|
|
)
|
|
LANGUAGE plpgsql VOLATILE
|
|
SECURITY DEFINER
|
|
AS
|
|
$$
|
|
DECLARE
|
|
m_funcname text = 'migrations_read';
|
|
m_errmsg text;
|
|
m_errcontext text;
|
|
m_errdetail text;
|
|
m_errhint text;
|
|
m_errstate text;
|
|
m_retval integer;
|
|
m_id_migration_model integer;
|
|
m_payload text;
|
|
m_tm timestamp;
|
|
|
|
m_xml xml;
|
|
m_json json;
|
|
j_err jsonb;
|
|
BEGIN
|
|
m_tm = clock_timestamp();
|
|
|
|
select f.id_migration_model
|
|
,convert_from(case when f_iscompressed(f.modelfile) = 'gzip' then pl_gzip_bytes(0,f.modelfile) else f.modelfile end, 'utf8')
|
|
from meta.migration_model f
|
|
where f.id_migration_model = p_id_migration_model
|
|
or p_id_migration_model is null
|
|
order by f.version desc , f.id_migration_model desc
|
|
into m_id_migration_model, m_payload;
|
|
|
|
if m_payload ilike '%<%>%'
|
|
then
|
|
m_xml = m_payload::xml;
|
|
raise notice 'XML File set';
|
|
elseif m_payload ilike '%{%}%'
|
|
then
|
|
raise notice 'JSON File set';
|
|
m_json = m_payload::json;
|
|
end if;
|
|
|
|
if m_xml is not null
|
|
then
|
|
|
|
perform pg_notify('upgrade.events', json_build_object('type','upgrade','status',1,'objecttype',m_funcname)::text);
|
|
|
|
p_info = jsonb_build_object('format','xml');
|
|
|
|
delete from meta.migration_table
|
|
where ismodel;
|
|
|
|
delete from meta.migration_index
|
|
where ismodel;
|
|
|
|
delete from meta.migration_relation_col d
|
|
where d.rid_migration_relation in (
|
|
select r.id_migration_relation
|
|
from meta.migration_relation r
|
|
where r.ismodel
|
|
);
|
|
|
|
delete from meta.migration_relation
|
|
where ismodel;
|
|
|
|
raise notice 'inserting meta.migration_table @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
drop table if exists tmp_meta_migration_table;
|
|
create temp table tmp_meta_migration_table as
|
|
select
|
|
lower((xpath('/table/tableident/text()', node.x))[1]::text)::citext as tableident
|
|
, lower((xpath('/table/prefix/text()', node.x))[1]::text)::citext as tableprefix
|
|
, lower((xpath('/table/tablename/text()', node.x))[1]::text)::citext as tablename
|
|
, lower(coalesce((xpath('/table/schema/text()', node.x))[1]::text,(xpath('/table/schemaname/text()', node.x))[1]::text)) as schemaname
|
|
, lower((xpath('/table/version/text()', node.x))[1]::text)::citext as version
|
|
, coalesce((xpath('/table/@seq', node.x))[1]::text,'0')::integer + 1 as schemapriority
|
|
, node.x as xml
|
|
from unnest(xpath('/root/tables/table', m_xml)) node(x)
|
|
;
|
|
|
|
insert into meta.migration_table(rid_migration_model ,guid,prefix, tablename, schemaname, version,ismodel, isdb,schemapriority)
|
|
select distinct on (r.tableident,r.tablename,r.tableprefix,r.schemaname)
|
|
m_id_migration_model
|
|
,r.tableident
|
|
,r.tableprefix
|
|
,r.tablename
|
|
,r.schemaname
|
|
,r.version
|
|
,true
|
|
,false
|
|
,r.schemapriority
|
|
from tmp_meta_migration_table r
|
|
;
|
|
|
|
|
|
raise notice 'inserting meta.migration_column @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
insert into meta.migration_column(rid_migration_table, columnname, guid, columntype,indextype,seqseed, columnlen, precision, defaultval)
|
|
select distinct on (r.id_migration_table,r.columnname,r.columnident)
|
|
r.id_migration_table,r.columnname,r.columnident,r.columntype,r.indextype,r.seq_seed,r.columnlen,r.precision
|
|
,r.defaultval
|
|
from (
|
|
select
|
|
mt.id_migration_table
|
|
, lower((xpath('/column/columnname/text()', col.x))[1]::text) as columnname
|
|
, (xpath('/column/columnident/text()', col.x))[1]::text as columnident
|
|
, (xpath('/column/columntype/text()', col.x))[1]::text as columntype
|
|
, (xpath('/column/indextype/text()', col.x))[1]::text as indextype
|
|
, coalesce((xpath('/column/seed/text()', col.x))[1]::text,'0')::bigint as seq_seed
|
|
, coalesce((xpath('/column/columnlen/text()', col.x))[1]::text, '0')::integer as columnlen
|
|
, coalesce((xpath('/column/precision/text()', col.x))[1]::text, '')::text as precision
|
|
, coalesce((xpath('/column/defaultval/text()', col.x))[1]::text, '')::text as defaultval
|
|
from tmp_meta_migration_table tbl
|
|
cross join unnest(xpath('/table/columns/column', tbl.xml)) col(x)
|
|
inner join meta.migration_table mt on mt.ismodel
|
|
and mt.rid_migration_model = m_id_migration_model
|
|
-- and lower(mt.guid) = lower((xpath('/table/tableident/text()', tbl.x))[1]::text)
|
|
and lower(mt.tablename) = lower(tbl.tablename)
|
|
and lower(mt.schemaname) =lower(tbl.schemaname)
|
|
) r
|
|
;
|
|
|
|
|
|
raise notice 'inserting meta.migration_index @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
insert into meta.migration_index(rid_migration_model,rid_migration_table, indexname, indextype, ispk,isduplicate, ispartial,partialstr, isunique, sequence, guid,ismodel)
|
|
select distinct on (r.id_migration_table,r.indexname)
|
|
m_id_migration_model
|
|
,r.id_migration_table
|
|
,r.indexname
|
|
|
|
,null
|
|
,r.indexprimary in ('1','true')
|
|
,r.indexduplicate in ('1','true')
|
|
,length(r.indexpartial) > 3
|
|
,r.indexpartial
|
|
,(not coalesce(r.indexduplicate,'') in ('1','true') and (r.indexunique in ('1','true') or r.indexprimary in ('1','true')))
|
|
,row_number() over (order by r.indexname)
|
|
,r.indexname
|
|
,true
|
|
from (
|
|
select
|
|
mt.id_migration_table
|
|
, mt.schemaname
|
|
, mt.tablename
|
|
, lower((xpath('/index/indexname/text()', idx.x))[1]::text) as indexname
|
|
, coalesce(lower((xpath('/index/indexprimary/text()', idx.x))[1]::text),'') as indexprimary
|
|
, coalesce(lower((xpath('/index/indexduplicate/text()', idx.x))[1]::text),'') as indexduplicate
|
|
, coalesce(lower((xpath('/index/indexpartial/text()', idx.x))[1]::text),'') as indexpartial
|
|
, coalesce(lower((xpath('/index/indexunique/text()', idx.x))[1]::text),'') as indexunique
|
|
from tmp_meta_migration_table tbl
|
|
cross join unnest(xpath('/table/indexes/index', tbl.xml)) idx(x)
|
|
inner join meta.migration_table mt on mt.ismodel
|
|
and mt.rid_migration_model = m_id_migration_model
|
|
and lower(mt.tablename) = lower(tbl.tablename)
|
|
and lower(mt.schemaname) =lower(tbl.schemaname)
|
|
) r
|
|
;
|
|
|
|
|
|
update meta.migration_index u
|
|
set isunique = true
|
|
where u.indexname ilike 'uk_%'
|
|
and not u.ispk
|
|
and not u.ispartial
|
|
and not u.isduplicate
|
|
;
|
|
|
|
-- update meta.migration_index u
|
|
-- set ispartial = true
|
|
-- where u.indexname ilike 'k_%'
|
|
-- and not u.isunique
|
|
-- and not u.ispk
|
|
-- ;
|
|
|
|
insert into meta.migration_index_col(rid_migration_index,rid_migration_column_parent,sequence)
|
|
select distinct on (r.id_migration_index,r.id_migration_column)
|
|
r.id_migration_index
|
|
,r.id_migration_column
|
|
,r.seq
|
|
from (
|
|
select
|
|
midx.id_migration_index
|
|
,mc.id_migration_column
|
|
,coalesce((xpath('/indexcolumn/@seq', idxcol.x))[1]::text,'0')::integer as seq
|
|
from tmp_meta_migration_table tbl
|
|
cross join unnest(xpath('/table/indexes/index', tbl.xml)) idx(x)
|
|
inner join meta.migration_table mt on mt.ismodel
|
|
and mt.rid_migration_model = m_id_migration_model
|
|
and lower(mt.tablename) = lower(tbl.tablename)
|
|
and lower(mt.schemaname) =lower(tbl.schemaname)
|
|
inner join meta.migration_index midx on midx.rid_migration_table = mt.id_migration_table
|
|
and midx.indexname = lower((xpath('/index/indexname/text()', idx.x))[1]::text)
|
|
|
|
cross join unnest(xpath('/index/indexcolumns/indexcolumn', idx.x)) idxcol(x)
|
|
inner join meta.migration_column mc on mt.id_migration_table = mc.rid_migration_table
|
|
and lower(mc.columnname) = lower((xpath('/indexcolumn/text()', idxcol.x))[1]::text)
|
|
) r
|
|
;
|
|
|
|
raise notice 'inserting meta.migration_relation temp table @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
drop table if exists tmp_meta_gigration_relation;
|
|
create temp table tmp_meta_gigration_relation as
|
|
select
|
|
tbl.tablename
|
|
,tbl.schemaname
|
|
, lower((xpath('/relation/childtable/text()', rel.x))[1]::text) as childtable
|
|
, lower((xpath('/relation/relationname/text()', rel.x))[1]::text) as relationname
|
|
, lower((xpath('/relation/relationguid/text()', rel.x))[1]::text) as relationguid
|
|
, lower((xpath('/relation/deleteconstraint/text()', rel.x))[1]::text) as deleteconstraint
|
|
, lower((xpath('/relation/updateconstraint/text()', rel.x))[1]::text) as updateconstraint
|
|
,rel.x as relation
|
|
from tmp_meta_migration_table tbl
|
|
cross join unnest(xpath('/table/relations/relation', tbl.xml)) rel(x)
|
|
;
|
|
|
|
raise notice 'inserting meta.migration_relation insert @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
insert
|
|
into meta.migration_relation( rid_migration_model
|
|
, rid_migration_table_parent
|
|
, rid_migration_table_child
|
|
, relationname
|
|
, guid
|
|
, updateconstraint
|
|
, deleteconstraint
|
|
, sequence
|
|
, ismodel)
|
|
select m_id_migration_model
|
|
,mt.id_migration_table
|
|
,ct.id_migration_table as rid_child_table
|
|
,src.relationname
|
|
,src.relationguid
|
|
,src.updateconstraint
|
|
,src.deleteconstraint
|
|
,row_number() over (order by src.relationname)
|
|
,true
|
|
from tmp_meta_gigration_relation as src
|
|
inner join meta.migration_table mt on mt.ismodel
|
|
and mt.rid_migration_model = m_id_migration_model
|
|
and lower(mt.tablename) = lower(src.tablename)
|
|
and lower(mt.schemaname) = lower(src.schemaname)
|
|
inner join meta.migration_table ct on ct.ismodel
|
|
and ct.rid_migration_model = m_id_migration_model
|
|
and lower(ct.schemaname) = lower(mt.schemaname)
|
|
and lower(ct.tablename) = lower(src.childtable)
|
|
;
|
|
|
|
raise notice 'inserting meta.migration_relation_col @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
insert into meta.migration_relation_col(rid_migration_relation, rid_migration_column_parent, rid_migration_column_child, sequence)
|
|
select mrel.id_migration_relation
|
|
, parcol.id_migration_column
|
|
, cldcol.id_migration_column
|
|
,coalesce((xpath('/keyfields/@seq', key.x))[1]::text,'0')::integer as seq
|
|
from tmp_meta_gigration_relation src
|
|
inner join meta.migration_table mt on mt.ismodel
|
|
and mt.rid_migration_model = m_id_migration_model
|
|
and lower(mt.tablename) = lower(src.tablename)
|
|
and lower(mt.schemaname) = lower(src.schemaname)
|
|
inner join meta.migration_relation mrel on mrel.rid_migration_table_parent = mt.id_migration_table
|
|
and lower(mrel.relationname) = lower(src.relationname)
|
|
cross join unnest(xpath('/relation/keyfields', src.relation)) key(x)
|
|
inner join meta.migration_column parcol on mrel.rid_migration_table_parent = parcol.rid_migration_table
|
|
and lower(parcol.columnname) = lower((xpath('/keyfields/parentcolumn/text()', key.x))[1]::text)
|
|
inner join meta.migration_column cldcol on mrel.rid_migration_table_child = cldcol.rid_migration_table
|
|
and lower(cldcol.columnname) = lower((xpath('/keyfields/childcolumn/text()', key.x))[1]::text)
|
|
;
|
|
|
|
raise notice 'inserting meta.migration_object @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
delete from meta.migration_object
|
|
where ismodel;
|
|
|
|
insert into meta.migration_object(rid_migration_model,objecttype,objectname, schema, version, checksum, sequence, priority, guid, body, ismodel, isdb)
|
|
select m_id_migration_model
|
|
,format('script:%s',r.scripttype)
|
|
,format('%s [%s]',r.scriptname,r.id_scriptcode)
|
|
,r.dbschema,r.version
|
|
, case when coalesce(r.scriptchecksum) <> '' then r.scriptchecksum else encode(sha256(convert_to(r.scriptcode,'utf8')),'hex') end
|
|
, r.sequence, r.priority, r.id_scriptcode::text,r.scriptcode,true,false
|
|
from (
|
|
select (xpath('/script/priority/text()', node.x))[1]::text::integer as priority
|
|
, (xpath('/script/sequence/text()', node.x))[1]::text::integer as sequence
|
|
, lower((xpath('/script/scriptname/text()', node.x))[1]::text)::citext as scriptname
|
|
, lower((xpath('/script/scripttype/text()', node.x))[1]::text)::citext as scripttype
|
|
, lower((xpath('/script/dbschema/text()', node.x))[1]::text)::citext as dbschema
|
|
, lower((xpath('/script/programname/text()', node.x))[1]::text)::citext as programname
|
|
, lower((xpath('/script/version/text()', node.x))[1]::text)::citext as version
|
|
, lower((xpath('/script/scriptchecksum/text()', node.x))[1]::text)::citext as scriptchecksum
|
|
, xml_extract_value('/script/code', node.x)::text as scriptcode
|
|
,'dct' as source
|
|
,(xpath('/script/id_scriptcode/text()', node.x))[1]::text::integer as id_scriptcode
|
|
from unnest(xpath('/root/scripts/script', m_xml )) node(x)
|
|
) r
|
|
;
|
|
|
|
elsif m_json is not null
|
|
then
|
|
p_info = jsonb_build_object('format','json');
|
|
raise exception 'Not yet supported';
|
|
else
|
|
p_info = jsonb_build_object('format','unknown');
|
|
raise exception 'Unsupported input file, Content: %', substr(m_payload, 1,20);
|
|
end if;
|
|
|
|
|
|
|
|
|
|
insert into meta.migration_column(rid_migration_table, columnname, columntype, guid)
|
|
select distinct on (t.id_migration_table)
|
|
t.id_migration_table, 'updatecnt', 'integer',format('updatecnt_%s', t.id_migration_table)
|
|
from meta.migration_table t
|
|
left outer join meta.migration_column c on c.rid_migration_table = t.id_migration_table
|
|
and c.columnname = 'updatecnt'
|
|
where t.ismodel
|
|
and t.tablename not in (
|
|
select uut.tablename
|
|
from meta.f_upgrade_table() uut
|
|
)
|
|
and c.id_migration_column is null
|
|
;
|
|
|
|
raise notice 'updates section @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
|
|
--Set primary key field from indexes
|
|
update meta.migration_column u
|
|
set ispk = true
|
|
from meta.migration_column c
|
|
inner join meta.migration_table t on t.id_migration_table = c.rid_migration_table
|
|
and t.ismodel
|
|
inner join meta.migration_index idx on idx.rid_migration_table = t.id_migration_table
|
|
inner join meta.migration_index_col idxcol on idxcol.rid_migration_index = idx.id_migration_index
|
|
and idxcol.rid_migration_column_parent = c.id_migration_column
|
|
where idx.ispk
|
|
and u.id_migration_column = c.id_migration_column
|
|
;
|
|
|
|
|
|
--Set length for strings
|
|
update meta.migration_column
|
|
set columnlen = reverse(substr(reverse(columntype),2,strpos(reverse(columntype),'(')-2))::integer
|
|
- (case when columntype ilike '%cstring%' then 1 else 0 end)
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and columntype ilike '%string%'
|
|
;
|
|
|
|
---Set the length and precision values
|
|
update meta.migration_column u
|
|
set columnlen = case when coalesce(u.columnlen,0) = 0 and (r.precision > 0 or r.scale > 0)
|
|
then coalesce(r.precision,0) + coalesce(r.scale,0)
|
|
else u.columnlen
|
|
end
|
|
,precision = format('%s,%s',r.precision,r.scale)
|
|
from (
|
|
select id_migration_column
|
|
,substring(columntype FROM '\((\d+),(\d+)\)')::integer AS precision
|
|
, substring(columntype FROM '\(\d+,(\d+)\)')::integer AS scale
|
|
from meta.migration_column
|
|
where
|
|
rid_migration_table in (
|
|
select t.id_migration_table from meta.migration_table t where t.ismodel
|
|
)
|
|
and columntype ilike '%(%)'
|
|
) r
|
|
where u.id_migration_column = r.id_migration_column
|
|
;
|
|
|
|
--Set default values for prefixes
|
|
update meta.migration_column u
|
|
set defaultval = (
|
|
select quote_literal(upper(t.prefix))
|
|
from meta.migration_table t
|
|
where t.id_migration_table = u.rid_migration_table
|
|
and t.ismodel
|
|
and nv(t.prefix) <> ''
|
|
)
|
|
where u.rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and u.columnname = 'prefix'
|
|
and coalesce(u.defaultval,'') = ''
|
|
;
|
|
|
|
--Set GUID field types. e.g. text, uuid
|
|
with option as (
|
|
select name, value
|
|
from meta.migration_option
|
|
where name = 'guidtype'
|
|
)
|
|
update meta.migration_column u
|
|
set columntype = option.value
|
|
,defaultval = case when nv(u.defaultval) = '' then 'newid()' else u.defaultval end
|
|
from option
|
|
where rid_migration_table in (
|
|
select t.id_migration_table
|
|
from meta.migration_table t
|
|
where t.ismodel
|
|
and not exists (
|
|
select 1
|
|
from meta.migration_option o
|
|
cross join regexp_split_to_table(o.value, ',') rex(v)
|
|
where o.name = 'textguid'
|
|
and rex.v::citext = t.tablename
|
|
and t.schemaname = 'public'
|
|
)
|
|
)
|
|
and (u.columnname in ('guid','uuid')
|
|
or u.columnname ilike 'guid%'
|
|
)
|
|
and u.columntype is distinct from option.value
|
|
|
|
;
|
|
|
|
--Limit length constraints
|
|
with option as (
|
|
select name, value::numeric as numvalue
|
|
from meta.migration_option
|
|
where name = 'max_constraint'
|
|
and value ~ '^-?[0-9]+(\.[0-9]+)?$'
|
|
)
|
|
update meta.migration_column u
|
|
set columnlen = 0
|
|
from option
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and u.columnlen >= option.numvalue
|
|
;
|
|
|
|
--Force names if json type options
|
|
with option as (
|
|
select name, value
|
|
from meta.migration_option
|
|
where name = 'settype_names_jsonb'
|
|
and value is not null
|
|
)
|
|
update meta.migration_column u
|
|
set columntype = 'jsonb'
|
|
from option
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and lower(u.columnname) in (
|
|
SELECT lower(t.v) from regexp_split_to_table(option.value, ',') t(v)
|
|
)
|
|
;
|
|
|
|
--Convert the program types to postgres types
|
|
update meta.migration_column u
|
|
set columntype = meta.f_datatype_map(u.columntype)
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and meta.f_datatype_map(u.columntype) not ilike '%unknown%'
|
|
;
|
|
|
|
update meta.migration_column u
|
|
set columntype = case when u.columntype in ('date','text','citext') and (u.columnname ilike '%datetime%' or u.columnname ilike '%timestamp%')
|
|
then 'timestamp'
|
|
else u.columntype
|
|
end
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and meta.f_datatype_map(u.columntype) not ilike '%unknown%'
|
|
;
|
|
|
|
|
|
--Larges objects has no lengths
|
|
update meta.migration_column u
|
|
set columnlen = 0
|
|
where rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
and lower(u.columntype) in ('blob,0','jsonb','json','blob','bytea')
|
|
;
|
|
|
|
j_err = null;
|
|
select jsonb_agg(
|
|
jsonb_build_object('tablename',t.tablename,'schemaname',t.schemaname,'word', kw.word)
|
|
)
|
|
from meta.migration_table t
|
|
inner join pg_get_keywords() kw on lower(kw.word) = lower(t.tablename)
|
|
and lower(kw.catdesc::text) = 'reserved'
|
|
where t.ismodel
|
|
into j_err
|
|
;
|
|
|
|
if jsonb_typeof(j_err) = 'array'
|
|
then
|
|
p_info = p_info || jsonb_build_object('table_reserved_words',j_err) ;
|
|
end if;
|
|
|
|
j_err = null;
|
|
select jsonb_agg(
|
|
jsonb_build_object('columnname',u.columnname,'tablename',t.tablename,'schemaname',t.schemaname,'word', kw.word)
|
|
)
|
|
from meta.migration_column u
|
|
inner join meta.migration_table t on t.id_migration_table = u.rid_migration_table
|
|
inner join pg_get_keywords() kw on lower(kw.word) = lower(u.columnname)
|
|
and lower(kw.catdesc::text) = 'reserved'
|
|
where u.rid_migration_table in (select t.id_migration_table from meta.migration_table t where t.ismodel)
|
|
into j_err
|
|
;
|
|
|
|
if jsonb_typeof(j_err) = 'array'
|
|
then
|
|
p_info = p_info || jsonb_build_object('column_reserved_words',j_err) ;
|
|
end if;
|
|
|
|
----Set the default value to the identity if the pk type is identity
|
|
update meta.migration_column u
|
|
set defaultval = r.def
|
|
from (
|
|
select
|
|
c.id_migration_column
|
|
,format($S$nextval('%s.identity_%s_%s'::regclass)$S$,t.schemaname,t.tablename,c.columnname) as def
|
|
from meta.migration_table t
|
|
inner join meta.migration_column c on c.rid_migration_table = t.id_migration_table
|
|
where
|
|
t.ismodel
|
|
and c.ispk
|
|
and nv(c.defaultval) = ''
|
|
and c.indextype = 'identity'
|
|
) r
|
|
where u.id_migration_column = r.id_migration_column;
|
|
|
|
update meta.migration_table u
|
|
set ismodel = false
|
|
where format('%s_%s',u.schemaname, u.tablename) in (
|
|
select format('%s_%s',split_part(o.name,':',2)
|
|
,t.name
|
|
)
|
|
from meta.migration_option o
|
|
cross join regexp_split_to_table(o.value,',') t(name)
|
|
where o.name ilike 'exclude:%'
|
|
and t.name <> ''
|
|
)
|
|
and u.ismodel
|
|
;
|
|
|
|
raise notice 'duplicates section @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
|
|
|
|
--Move duplicate tables that exists in the settings to their default location. Move the keys as well.
|
|
with move as (
|
|
select
|
|
t1.schemaname
|
|
, t1.tablename
|
|
, t1.id_migration_table as id_migration_table_dest
|
|
, t2.schemaname
|
|
, t2.tablename
|
|
, t2.id_migration_table as id_migration_table_src
|
|
,format('%s.%s',t1.schemaname, t1.tablename) as named
|
|
from meta.migration_table t1
|
|
inner join meta.migration_table t2 on t2.ismodel
|
|
and t2.tablename = t1.tablename
|
|
and t2.schemaname is distinct from t1.schemaname
|
|
where
|
|
t1.ismodel
|
|
--and not t1.isdb
|
|
and (
|
|
format('%s.%s',t1.schemaname, t1.tablename) in (
|
|
select format('%s.%s',o.value,lower(split_part(o.name, ':', 2)))
|
|
from meta.migration_option o
|
|
where o.name ilike 'default_schema:%'
|
|
)
|
|
)
|
|
), cols as (
|
|
update meta.migration_column u
|
|
set rid_migration_table = m.id_migration_table_dest
|
|
from move m
|
|
inner join meta.migration_column c1 on c1.rid_migration_table = m.id_migration_table_src
|
|
and c1.columnname not in (
|
|
select c2.columnname
|
|
from meta.migration_column c2
|
|
where c2.rid_migration_table = m.id_migration_table_dest
|
|
)
|
|
where u.id_migration_column = c1.id_migration_column
|
|
returning *
|
|
), relations1 as (
|
|
update meta.migration_relation u
|
|
set rid_migration_table_parent = m.id_migration_table_dest
|
|
,relationname = format('%s_merged',u.relationname)
|
|
from move m
|
|
where u.rid_migration_table_parent = m.id_migration_table_src
|
|
returning *
|
|
), relations2 as (
|
|
update meta.migration_relation u
|
|
set rid_migration_table_child = m.id_migration_table_dest
|
|
,relationname = format('%s_merged',u.relationname)
|
|
from move m
|
|
where u.rid_migration_table_child = m.id_migration_table_src
|
|
returning *
|
|
), relationscols as (
|
|
update meta.migration_relation_col u
|
|
set rid_migration_column_child = mc2.id_migration_column
|
|
from move m
|
|
inner join meta.migration_column mc on mc.rid_migration_table = m.id_migration_table_src
|
|
inner join meta.migration_column mc2 on mc2.rid_migration_table = m.id_migration_table_dest
|
|
and mc2.columnname = mc.columnname
|
|
inner join meta.migration_relation_col rc on rc.rid_migration_column_child = mc.id_migration_column
|
|
where u.id_migration_relationcol = rc.id_migration_relationcol
|
|
), relationscols2 as (
|
|
update meta.migration_relation_col u
|
|
set rid_migration_column_parent = mc2.id_migration_column
|
|
from move m
|
|
inner join meta.migration_column mc on mc.rid_migration_table = m.id_migration_table_src
|
|
inner join meta.migration_column mc2 on mc2.rid_migration_table = m.id_migration_table_dest
|
|
and mc2.columnname = mc.columnname
|
|
inner join meta.migration_relation_col rc on rc.rid_migration_column_parent = mc.id_migration_column
|
|
where u.id_migration_relationcol = rc.id_migration_relationcol
|
|
), idx as (
|
|
update meta.migration_index u
|
|
set rid_migration_table = m.id_migration_table_dest
|
|
from move m
|
|
where u.rid_migration_table = m.id_migration_table_src
|
|
returning *
|
|
), idxcols as (
|
|
update meta.migration_index_col u
|
|
set rid_migration_column_parent = col.id_migration_column
|
|
from move m
|
|
inner join meta.migration_column col on col.rid_migration_table = m.id_migration_table_src
|
|
inner join meta.migration_column col2 on col2.rid_migration_table = m.id_migration_table_dest
|
|
and col2.columnname = col.columnname
|
|
where u.rid_migration_column_parent = col.id_migration_column
|
|
)
|
|
update meta.migration_table u
|
|
set ismodel = false
|
|
from move mv
|
|
where u.id_migration_table = mv.id_migration_table_src;
|
|
|
|
|
|
update meta.migration_index u
|
|
set indexname = format('%s_%s_%s',u.indexname,tbl.schemaname,tbl.tablename)
|
|
from meta.migration_table tbl
|
|
where u.rid_migration_table = tbl.id_migration_table
|
|
and u.indexname not ilike '%' || tbl.schemaname ||'%' || tbl.tablename || '%s'
|
|
;
|
|
|
|
|
|
|
|
|
|
--disable and report duplicates. Take the high priority schema
|
|
|
|
with dup as (
|
|
select
|
|
t.tablename as tablename_src
|
|
, t2.tablename as tablename_dest
|
|
, t.schemaname as schemaname_src
|
|
, t2.schemaname as schemaname_dest
|
|
, t.id_migration_table as id_migration_table_dest
|
|
, t2.id_migration_table as id_migration_table_src
|
|
from meta.migration_table t
|
|
inner join meta.migration_table t2 on t2.ismodel
|
|
and t.tablename = t2.tablename
|
|
and t.schemaname is distinct from t2.schemaname
|
|
and t.schemapriority < t2.schemapriority
|
|
where t.ismodel
|
|
and exists (
|
|
select *
|
|
from meta.migration_option o
|
|
where o.name ilike 'default_schema:%'
|
|
and (split_part(o.name, ':', 2) = t.tablename
|
|
or split_part(o.name, ':', 2) = t2.tablename
|
|
)
|
|
)
|
|
), upd as (
|
|
update meta.migration_table u
|
|
set ismodel = false
|
|
from dup
|
|
where u.id_migration_table = dup.id_migration_table_src
|
|
returning *
|
|
)
|
|
select jsonb_agg(to_jsonb(dup))
|
|
from dup
|
|
into m_json;
|
|
|
|
|
|
|
|
insert into meta.table_prefix(schemaname,tablename, prefix)
|
|
select distinct t.schemaname,t.tablename,t.prefix
|
|
from meta.migration_table t
|
|
where t.ismodel
|
|
and coalesce(t.prefix,'') <> ''
|
|
and not exists (
|
|
select 1 from meta.table_prefix p where p.schemaname = t.schemaname and p.tablename = t.tablename
|
|
);
|
|
|
|
update meta.table_prefix u
|
|
set prefix = t.prefix
|
|
from meta.migration_table t
|
|
where t.ismodel
|
|
and u.tablename = t.tablename
|
|
and u.schemaname = t.schemaname
|
|
and u.prefix is distinct from t.prefix
|
|
;
|
|
|
|
update meta.migration_relation u
|
|
set ismodel = false
|
|
from (
|
|
select max(mr.rid_migration_table_child) as rid_migration_table_child
|
|
, max(mr.rid_migration_table_parent) as rid_migration_table_parent
|
|
, count(1) as cnt
|
|
, array_agg(mr.id_migration_relation) as a_id_migration_relation
|
|
, min(mr.id_migration_relation) as id_migration_relation_keep
|
|
, array_agg(mr.relationname)
|
|
,string_agg(c1.columnname,'_')
|
|
from meta.migration_relation mr
|
|
inner join meta.migration_relation_col rc on rc.rid_migration_relation = mr.id_migration_relation
|
|
inner join meta.migration_table t1 on t1.id_migration_table = mr.rid_migration_table_parent
|
|
inner join meta.migration_table t2 on t2.id_migration_table = mr.rid_migration_table_child
|
|
inner join meta.migration_column c1 on c1.id_migration_column = rc.rid_migration_column_parent
|
|
inner join meta.migration_column c2 on c2.id_migration_column = rc.rid_migration_column_child
|
|
where mr.ismodel
|
|
|
|
group by t1.schemaname, t1.tablename,t2.schemaname,t2.tablename,c1.columnname,c2.columnname
|
|
having count(1) > 1
|
|
) r
|
|
where u.id_migration_relation = any(a_id_migration_relation)
|
|
and u.id_migration_relation <> r.id_migration_relation_keep
|
|
;
|
|
|
|
/*
|
|
update meta.migration_relation u
|
|
set ismodel = false
|
|
,isdb = false
|
|
from (
|
|
select mr.relationname
|
|
, mr.rid_migration_table_child
|
|
, mr.rid_migration_table_parent
|
|
, count(1) as cnt
|
|
, array_agg(mr.id_migration_relation) as a_id_migration_relation
|
|
, min(mr.id_migration_relation) as id_migration_relation
|
|
from meta.migration_relation mr
|
|
where mr.ismodel
|
|
group by mr.relationname, mr.rid_migration_table_child, mr.rid_migration_table_parent
|
|
) r
|
|
where u.id_migration_relation = any(r.a_id_migration_relation)
|
|
and u.id_migration_relation is distinct from r.id_migration_relation
|
|
;
|
|
*/
|
|
|
|
|
|
raise notice 'done @ %', (clock_timestamp() - m_tm)::interval;
|
|
m_tm = clock_timestamp();
|
|
|
|
|
|
|
|
p_info = coalesce(jsonb_concat(p_info, m_json::jsonb),p_info);
|
|
perform pg_notify('upgrade.events', json_build_object('type','upgrade','status',2,'objecttype',m_funcname)::text);
|
|
|
|
EXCEPTION
|
|
WHEN others THEN
|
|
GET STACKED DIAGNOSTICS
|
|
m_errmsg = MESSAGE_TEXT
|
|
,m_errcontext = PG_EXCEPTION_CONTEXT
|
|
,m_errdetail = PG_EXCEPTION_DETAIL
|
|
,m_errhint = PG_EXCEPTION_HINT
|
|
,m_errstate = RETURNED_SQLSTATE;
|
|
|
|
p_retval = 1;
|
|
p_errmsg = format('%s Context %s State: %s', m_errmsg, m_errcontext, m_errstate);
|
|
raise warning '% % hint:% state:% context:%',m_errmsg,m_errdetail,m_errhint,m_errstate,m_errcontext;
|
|
perform pg_notify('upgrade.events', json_build_object('type','upgrade','status',3,'error',m_errmsg,'objecttype',m_funcname)::text);
|
|
END;
|
|
$$; |