unit uDAPostgresInterfaces; {----------------------------------------------------------------------------} { Data Abstract Library - Core Library } { } { compiler: Delphi 6 and up, Kylix 3 and up } { platform: Win32, Linux } { } { (c)opyright RemObjects Software. all rights reserved. } { } { Using this code requires a valid license of the Data Abstract } { which can be obtained at http://www.remobjects.com. } {----------------------------------------------------------------------------} {$I DataAbstract.inc} interface uses SysUtils, uDAInterfaces, uDAEngine, uROClasses; type { IDAPostgresConnection For identification purposes Implemented by all Postgres connections } IDAPostgresConnection = interface(IDAConnection) ['{D8EADB7E-7AA0-48FF-9E7D-34853F999BFC}'] end; TDAPostgresDriver = class(TDAEDriver) protected function GetDefaultConnectionType(const AuxDriver: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} public end; TDAEPostgresConnection = class(TDAEConnection, IDAPostgresConnection, IDACanQueryDatabaseNames, IDAUseGenerators) protected function DoGetLastAutoInc(const GeneratorName: string): integer; override; procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override; procedure DoGetTableNames(out List: IROStrings); override; procedure DoGetViewNames(out List: IROStrings); override; procedure DoGetStoredProcedureNames(out List: IROStrings); override; procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override; function GetSPSelectSyntax(HasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override; function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} // IDACanQueryDatabaseNames function GetDatabaseNames: IROStrings; // IDAUseGenerators function GetNextAutoinc(const GeneratorName: string): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} end; function Postgres_GetDatabaseNames(aConnection: TDAEConnection): IROStrings; function Postgres_DoGetLastAutoInc(const GeneratorName: string; Query: IDADataset): integer; function Postgres_GetNextAutoInc(const GeneratorName: string; Query: IDADataset): integer; procedure Postgres_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection); procedure Postgres_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype); function PostgresDataTypeToDA(aDataType: string; Unicode: Boolean=False): TDADataType; procedure Postgres_DoGetForeignKeys(Query: IDADataset;ForeignKeys: TDADriverForeignKeyCollection); function Postgres_GetSPSelectSyntax(HasArguments: Boolean): String; procedure Postgres_DoGetStoredProcedureParams(const aStoredProcedureName: string; Query: IDADataset; out Params: TDAParamCollection); function Postgres_IdentifierNeedsQuoting(const iIdentifier: string): boolean; const PostgreSQL_DriverType = 'PostgreSQL'; implementation var postgres_reservedwords: array of string; const Postgres_MasterDatabase = 'template1'; Postgres_GetDatabaseNames_SQL = 'SELECT datname FROM pg_database ORDER BY datname'; function PostgresDataTypeToDA(aDataType: string; Unicode: Boolean): TDADataType; begin aDataType := LowerCase(aDataType); if pos(' ', aDataType) <> 0 then Delete(aDataType, Pos(' ', aDataType), MaxInt); if (aDAtaType = 'varchar') or (aDataType = 'character varying') or (aDataType = 'character') or (aDataType = 'char') or (aDataType = '"char"') or (aDataType = 'name') then begin if Unicode then Result := datWideString else Result := datString; end else if aDataType = 'text' then begin if Unicode then Result := datWideMemo else Result := datMemo; end else if (aDataType = 'blob') or (aDataType = 'binary') or (aDataType = 'varbinary') or (aDataType = 'bytea') or (aDataType = 'binary large object') then Result := datBlob else if (aDataType = 'date') or (aDataType = 'absdate') or (aDataType = 'time') or (aDataType = 'timetz') or (aDataType = 'datetime') or (aDataType = 'timestamp') or (aDataType = 'timestamptz') or (aDataType = 'year') then result := datDateTime else if (aDataType = 'single') or (aDataType = 'real') or (aDataType = 'float4') then Result := datSingleFloat else if (aDataType = 'double') or (aDataType = 'float') or (aDataType = 'doubleprecision') or (aDataType = 'float8') then Result := datFloat else if (aDataType = 'bit') or (aDataType = 'boolean') or (aDataType = 'bool') then Result := datBoolean else if (aDataType = 'bigint') or (aDataType = 'int8') then result := datLargeInt else if (aDataType = 'decimal') or (aDataType = 'numeric') then result := datDecimal else if (aDataType = 'money') then result := datCurrency else if (aDataType = 'serial') or (aDataType = 'serial4') then result := datAutoInc else if (aDataType = 'bigserial') or (aDataType = 'serial8') then result := datLargeAutoInc else if (aDataType = 'smallint') or (aDataType = 'int2') then result := datSmallInt else if (aDataType = 'shortint') or (aDataType = 'int1') then result := datShortInt else if (aDataType = 'enum') or (aDataType = 'int4') or (adatatype = 'int') or (adatatype = 'integer') or (aDataType = 'tinyint') then result := datInteger else result := datUnknown; end; function Postgres_GetDatabaseNames(aConnection: TDAEConnection): IROStrings; begin Result := Engine_GetDatabaseNames(aConnection, Postgres_MasterDatabase, Postgres_GetDatabaseNames_SQL); end; function Postgres_DoGetLastAutoInc(const GeneratorName: string; Query: IDADataset): integer; begin try Query.SQL := 'SELECT currval(''' + GeneratorName + ''')'; Query.Open; result := Query.Fields[0].Value; finally Query := nil; end; end; function Postgres_GetNextAutoInc(const GeneratorName: string; Query: IDADataset): integer; begin try Query.SQL := 'SELECT nextval(''' + GeneratorName + ''')'; Query.Open; result := Query.Fields[0].Value; finally Query := nil; end; end; procedure Postgres_DoGetTableFields(const aTableName: string; Query: IDADataset; out Fields: TDAFieldCollection); const main_sql = 'SELECT COLUMN_NAME, DATA_TYPE, IS_NULLABLE, COLUMN_DEFAULT, CHARACTER_MAXIMUM_LENGTH, CHARACTER_SET_NAME, NUMERIC_PRECISION, NUMERIC_SCALE ' + 'FROM INFORMATION_SCHEMA.COLUMNS ' + 'WHERE TABLE_NAME=''{tbl}'' and TABLE_SCHEMA=''{schem}'' ' + 'ORDER BY ORDINAL_POSITION'; pk_sql = 'SELECT COLUMN_NAME ' + 'FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE ' + 'WHERE TABLE_NAME=''{tbl}'' and TABLE_SCHEMA=''{schem}'' AND CONSTRAINT_NAME like ''%_pkey'''; var fld : TDAField; lSchema, lTable : string; p1 : integer; s : string; begin Fields := TDAFieldCollection.Create(nil); try { Query.SQL := 'SELECT * FROM ' + aTableName + ' WHERE 1=0'; Query.Open; Fields.Assign(Query.Fields); Query.Close; } Query.SQL := main_sql; lTable := aTableName; if pos('.', lTable) = 0 then begin lSchema := 'public' end else begin lSchema := copy(lTable, 1, pos('.', lTable) - 1); Delete(lTable, 1, pos('.', lTable)); end; Query.SQL := StringReplace(Query.SQL, '{tbl}', lTable, []); Query.SQL := StringReplace(Query.SQL, '{schem}', lSchema, []); Query.Open; while not Query.Eof do begin fld := Fields.Add; fld.Name:=Query.Fields[0].AsString; fld.Required := Query.Fields[2].AsString <> 'YES'; fld.DefaultValue := Query.Fields[3].AsString; fld.DataType := PostgresDataTypeToDA(Query.Fields[1].asString, sametext(Query.Fields[5].AsString, 'utf8') or sametext(Query.Fields[5].AsString, 'utf16')); if fld.DataType = datDecimal then begin fld.DecimalPrecision := Query.Fields[6].asInteger; fld.DecimalScale := Query.Fields[7].asInteger; end; if Query.Fields[1].asString = '"char"' then fld.size := 1 else if Query.Fields[1].asString = 'name' then fld.size := 63 else fld.Size := Query.Fields[4].AsInteger; if fld.DefaultValue <> '' then begin if pos('nextval(', fld.DefaultValue) = 1 then begin case fld.DataType of datInteger: fld.DataType := datAutoInc; datLargeInt: fld.DataType := datLargeAutoInc; else fld.DefaultValue := ''; end; if fld.DefaultValue <> '' then begin s := fld.DefaultValue; p1 := pos('''', s); Delete(s, 1, p1); p1 := pos('''', s); fld.GeneratorName := Copy(s, 1, p1 - 1); fld.DefaultValue := ''; end; end else if not TestDefaultValue(fld.DefaultValue, fld.DataType) then begin fld.DefaultValue := ''; end; end; Query.Next; end; Query.Close; Query.SQL := pk_sql; Query.SQL := StringReplace(Query.SQL, '{tbl}', lTable, []); Query.SQL := StringReplace(Query.SQL, '{schem}', lSchema, []); Query.Open; while not Query.Eof do begin fld := Fields.FindField(Query.Fields[0].AsString); if fld <> nil then fld.InPrimaryKey := true; Query.Next; end; finally Query := nil; end; end; procedure Postgres_DoGetNames(Query: IDADataset; AList: IROStrings; AObjectType: TDAObjecttype); const c_select = 'SELECT pg_namespace.nspname, pg_class.relname FROM pg_class, pg_namespace '+ 'WHERE (pg_class.relkind = ''r'') AND (pg_namespace.oid = pg_class.relnamespace) AND '+ '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2'; c_stored = 'SELECT pg_namespace.nspname, pg_proc.proname '+ 'FROM pg_namespace, pg_proc '+ 'WHERE pg_namespace.oid = pg_proc.pronamespace and '+ '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2'; c_view = 'SELECT pg_namespace.nspname, pg_class.relname FROM pg_class, pg_namespace '+ 'WHERE (pg_class.relkind = ''v'') AND (pg_namespace.oid = pg_class.relnamespace) AND '+ '(pg_namespace.nspname NOT LIKE ''pg_%'') AND (pg_namespace.nspname NOT LIKE ''information_schema'') ORDER BY 1,2'; begin try case AObjectType of dotTable: Query.SQL := c_select; dotProcedure: Query.SQL := c_stored; dotView: Query.SQL := c_view; else end; Query.Open; while not Query.EOF do begin if SameText(Query.fields[0].AsString, 'public') then AList.Add(Trim(Query.Fields[1].AsString)) else AList.Add(Trim(Query.Fields[0].AsString)+'.'+Trim(Query.Fields[1].AsString)); Query.Next; end; Query.Close; finally Query := nil; end; end; procedure Postgres_DoGetForeignKeys(Query: IDADataset;ForeignKeys: TDADriverForeignKeyCollection); const s_sql = 'select c.conname,s.seq,fn.nspname,f.relname,fa.attname,pn.nspname,p.relname,pa.attname '+ 'from pg_constraint c join pg_class p ON (c.conrelid = p.oid) join pg_namespace pn ON (p.relnamespace = pn.oid) '+ 'join pg_class f ON (c.confrelid = f.oid) join pg_namespace fn ON (f.relnamespace = fn.oid) '+ 'join (select s.seq from generate_series(0,100) as s(seq)) as s on ( s.seq BETWEEN array_lower(conkey,1) and array_upper(conkey,1)) '+ 'join pg_attribute pa ON ((c.conrelid = pa.attrelid) and (pa.attnum = c.conkey[s.seq])) '+ 'join pg_attribute fa ON ((c.confrelid = fa.attrelid) and (fa.attnum = c.confkey[s.seq])) '+ 'WHERE c.contype=''f'' ORDER by 1,3,4,2'; var lCurrConstraint: string; lCurrFK: TDADriverForeignKey; begin lCurrConstraint:=''; lCurrFK := nil; ForeignKeys.Clear; try Query.SQL := s_sql; Query.Open; while not Query.Eof do begin if lCurrConstraint <> Query.Fields[0].AsString then begin lCurrConstraint := Query.Fields[0].AsString; lCurrFK := ForeignKeys.Add(); with lCurrFK do begin Name := Trim(Query.Fields[0].AsString); if not SameText(Query.fields[2].AsString, 'public') then PKTable := Format('%s.%s', [Trim(Query.Fields[2].AsString), Trim(Query.Fields[3].AsString)]) else PKTable := Trim(Query.Fields[3].AsString); if not SameText(Query.fields[5].AsString, 'public') then FKTable := Format('%s.%s', [Trim(Query.fields[5].AsString), Trim(Query.fields[6].AsString)]) else FKTable := Trim(Query.fields[6].AsString); PKField := Trim(Query.Fields[4].AsString); FKField := Trim(Query.Fields[7].AsString); end end else with lCurrFK do begin PKField := PKField + ';' + TrimRight(Query.Fields[4].AsString); FKField := FKField + ';' + TrimRight(Query.Fields[7].AsString); end; Query.Next; end; Query.Close; finally Query := nil; end; end; function Postgres_GetSPSelectSyntax(HasArguments: Boolean): String; begin if HasArguments then Result := 'SELECT * FROM {0}({1})' else Result := 'SELECT * FROM {0}()'; end; procedure Postgres_DoGetStoredProcedureParams(const aStoredProcedureName: string; Query: IDADataset; out Params: TDAParamCollection); const s_sql= 'select ns.nspname as schema,p.proname as name, ' + // '/* p.pronargs,p.proretset,p.prorettype,p.proargtypes,p.proallargtypes,p.proargmodes,p.proargnames,*/ ' + 'COALESCE(s.seq,1) as paramnumber,ipt.typname as paramtype, ' + 'COALESCE(p.proargmodes[s.seq], case when (p.pronargs < s.seq) then ''r'' else ''i'' end) as parammode, ' + 'COALESCE(p.proargnames[s.seq], case when (p.proargmodes[s.seq] is null) and (p.pronargs < s.seq) then ''result'' else ''$''||s.seq end) as paramname '+ 'from pg_proc p '+ 'join pg_namespace ns on ((p.pronamespace = ns.oid)) '+ // and (ns.nspname not like ''pg_%'') and (ns.nspname <> ''information_schema'')) ' + 'join (select s.seq from generate_series(0,100) as s(seq)) as s on (s.seq between COALESCE(array_lower(p.proallargtypes,1),1) and COALESCE(array_upper(p.proallargtypes,1),p.pronargs+1)) ' + 'join pg_type ipt on (COALESCE(p.proargtypes[s.seq-1],p.proallargtypes[s.seq-1],prorettype) =ipt.oid) '; s_where='where (ns.nspname = ''%s'') and (p.proname = ''%s'') '; s_order='order by schema,name,paramnumber'; var schema, proc:string; s: string; begin Params := TDAParamCollection.Create(nil); if Pos('.', aStoredProcedureName) > 0 then begin schema := Trim(Copy(aStoredProcedureName, 1, Pos('.', aStoredProcedureName) - 1)); proc := Trim(Copy(aStoredProcedureName, Pos('.', aStoredProcedureName) + 1, Length(aStoredProcedureName))); end else begin schema := 'public'; proc := aStoredProcedureName; end; Query.SQL:= s_sql+ Format(s_where,[schema,proc])+s_order; Query.Open; while not Query.EOF do begin With Params.Add do begin s:= Query.Fields[4].AsString; if s = 'r' then ParamType:=daptResult else if s = 'o' then ParamType:=daptOutput else if s = 'b' then ParamType:=daptInputOutput else ParamType:=daptInput; Name := Query.Fields[5].AsString; DataType := PostgresDataTypeToDA(Query.Fields[3].AsString); end; Query.Next; end; end; function Postgres_IdentifierNeedsQuoting(const iIdentifier: string): boolean; begin Result:= (LowerCase(iIdentifier) <> iIdentifier) or TestIdentifier(iIdentifier, postgres_reservedwords); end; { TDAEPostgresConnection } procedure TDAEPostgresConnection.DoGetForeignKeys( out ForeignKeys: TDADriverForeignKeyCollection); begin inherited; Postgres_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys); end; function TDAEPostgresConnection.DoGetLastAutoInc( const GeneratorName: string): integer; begin Result := Postgres_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self)); end; procedure TDAEPostgresConnection.DoGetStoredProcedureNames( out List: IROStrings); begin inherited; Postgres_DoGetNames(GetDatasetClass.Create(Self),List,dotProcedure); end; procedure TDAEPostgresConnection.DoGetStoredProcedureParams( const aStoredProcedureName: string; out Params: TDAParamCollection); begin inherited; exit; // Postgres_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params); end; procedure TDAEPostgresConnection.DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); begin Postgres_DoGetTableFields(aTableName, GetDatasetClass.Create(Self), Fields); end; procedure TDAEPostgresConnection.DoGetTableNames(out List: IROStrings); begin inherited; Postgres_DoGetNames(GetDatasetClass.Create(Self),List,dotTable); end; procedure TDAEPostgresConnection.DoGetViewNames(out List: IROStrings); begin inherited; Postgres_DoGetNames(GetDatasetClass.Create(Self), List, dotView); end; function TDAEPostgresConnection.GetDatabaseNames: IROStrings; begin Result := Postgres_GetDatabaseNames(Self); end; function TDAEPostgresConnection.GetNextAutoinc( const GeneratorName: string): integer; begin Result := Postgres_GetNextAutoInc(GeneratorName, GetDatasetClass.Create(Self)); end; function TDAEPostgresConnection.GetSPSelectSyntax( HasArguments: Boolean): string; begin Result:= Postgres_GetSPSelectSyntax(HasArguments); end; function TDAEPostgresConnection.IdentifierNeedsQuoting( const iIdentifier: string): boolean; begin Result:= inherited IdentifierNeedsQuoting(iIdentifier) or Postgres_IdentifierNeedsQuoting(iIdentifier); end; { TDAPostgresDriver } function TDAPostgresDriver.GetDefaultConnectionType( const AuxDriver: string): string; begin Result:= PostgreSQL_DriverType; end; procedure postgres_InitializeReservedWords; begin SetLength(postgres_reservedwords, 95); // sorted with TStringList.Sort (bds2007) postgres_reservedwords[0] := 'ALL'; postgres_reservedwords[1] := 'ANALYSE'; postgres_reservedwords[2] := 'ANALYZE'; postgres_reservedwords[3] := 'AND'; postgres_reservedwords[4] := 'ANY'; postgres_reservedwords[5] := 'ARRAY'; postgres_reservedwords[6] := 'AS'; postgres_reservedwords[7] := 'ASC'; postgres_reservedwords[8] := 'ASYMMETRIC'; postgres_reservedwords[9] := 'AUTHORIZATION'; postgres_reservedwords[10] := 'BETWEEN'; postgres_reservedwords[11] := 'BINARY'; postgres_reservedwords[12] := 'BOTH'; postgres_reservedwords[13] := 'CASE'; postgres_reservedwords[14] := 'CAST'; postgres_reservedwords[15] := 'CHECK'; postgres_reservedwords[16] := 'COLLATE'; postgres_reservedwords[17] := 'COLUMN'; postgres_reservedwords[18] := 'CONSTRAINT'; postgres_reservedwords[19] := 'CREATE'; postgres_reservedwords[20] := 'CROSS'; postgres_reservedwords[21] := 'CURRENT_DATE'; postgres_reservedwords[22] := 'CURRENT_ROLE'; postgres_reservedwords[23] := 'CURRENT_TIME'; postgres_reservedwords[24] := 'CURRENT_TIMESTAMP'; postgres_reservedwords[25] := 'CURRENT_USER'; postgres_reservedwords[26] := 'DEFAULT'; postgres_reservedwords[27] := 'DEFERRABLE'; postgres_reservedwords[28] := 'DESC'; postgres_reservedwords[29] := 'DISTINCT'; postgres_reservedwords[30] := 'DO'; postgres_reservedwords[31] := 'ELSE'; postgres_reservedwords[32] := 'END'; postgres_reservedwords[33] := 'EXCEPT'; postgres_reservedwords[34] := 'FALSE'; postgres_reservedwords[35] := 'FOR'; postgres_reservedwords[36] := 'FOREIGN'; postgres_reservedwords[37] := 'FREEZE'; postgres_reservedwords[38] := 'FROM'; postgres_reservedwords[39] := 'FULL'; postgres_reservedwords[40] := 'GRANT'; postgres_reservedwords[41] := 'GROUP'; postgres_reservedwords[42] := 'HAVING'; postgres_reservedwords[43] := 'ILIKE'; postgres_reservedwords[44] := 'IN'; postgres_reservedwords[45] := 'INITIALLY'; postgres_reservedwords[46] := 'INNER'; postgres_reservedwords[47] := 'INTERSECT'; postgres_reservedwords[48] := 'INTO'; postgres_reservedwords[49] := 'IS'; postgres_reservedwords[50] := 'ISNULL'; postgres_reservedwords[51] := 'JOIN'; postgres_reservedwords[52] := 'LEADING'; postgres_reservedwords[53] := 'LEFT'; postgres_reservedwords[54] := 'LIKE'; postgres_reservedwords[55] := 'LIMIT'; postgres_reservedwords[56] := 'LOCALTIME'; postgres_reservedwords[57] := 'LOCALTIMESTAMP'; postgres_reservedwords[58] := 'NATURAL'; postgres_reservedwords[59] := 'NEW'; postgres_reservedwords[60] := 'NOT'; postgres_reservedwords[61] := 'NOTNULL'; postgres_reservedwords[62] := 'NULL'; postgres_reservedwords[63] := 'OFF'; postgres_reservedwords[64] := 'OFFSET'; postgres_reservedwords[65] := 'OLD'; postgres_reservedwords[66] := 'ON'; postgres_reservedwords[67] := 'ONLY'; postgres_reservedwords[68] := 'OR'; postgres_reservedwords[69] := 'ORDER'; postgres_reservedwords[70] := 'OUTER'; postgres_reservedwords[71] := 'OVERLAPS'; postgres_reservedwords[72] := 'PLACING'; postgres_reservedwords[73] := 'PRIMARY'; postgres_reservedwords[74] := 'REFERENCES'; postgres_reservedwords[75] := 'RETURNING'; postgres_reservedwords[76] := 'RIGHT'; postgres_reservedwords[77] := 'SELECT'; postgres_reservedwords[78] := 'SESSION_USER'; postgres_reservedwords[79] := 'SIMILAR'; postgres_reservedwords[80] := 'SOME'; postgres_reservedwords[81] := 'SYMMETRIC'; postgres_reservedwords[82] := 'TABLE'; postgres_reservedwords[83] := 'THEN'; postgres_reservedwords[84] := 'TO'; postgres_reservedwords[85] := 'TRAILING'; postgres_reservedwords[86] := 'TRUE'; postgres_reservedwords[87] := 'UNION'; postgres_reservedwords[88] := 'UNIQUE'; postgres_reservedwords[89] := 'USER'; postgres_reservedwords[90] := 'USING'; postgres_reservedwords[91] := 'VERBOSE'; postgres_reservedwords[92] := 'WHEN'; postgres_reservedwords[93] := 'WHERE'; postgres_reservedwords[94] := 'WITH'; end; initialization postgres_InitializeReservedWords; finalization postgres_reservedwords := nil; end.