ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBExtract.pas
(Generate patch)

Comparing ibx/trunk/runtime/nongui/IBExtract.pas (file contents):
Revision 220 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 221 by tony, Mon Mar 19 09:48:37 2018 UTC

# Line 52 | Line 52 | uses
52  
53   type
54    TExtractObjectTypes =
55 <    (eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction,
55 >    (eoDatabase, eoDomain, eoTable, eoView, eoProcedure, eoFunction, eoPackage,
56       eoGenerator, eoException, eoBLOBFilter, eoRole, eoTrigger, eoForeign,
57       eoIndexes, eoChecks, eoData);
58  
# Line 64 | Line 64 | type
64  
65    TProcDDLType = (pdCreateProc,pdCreateStub,pdAlterProc);
66  
67 +  TPackageDDLType = (paHeader,paBody,paBoth);
68 +
69    { TIBExtract }
70  
71    TIBExtract = class(TComponent)
# Line 96 | Line 98 | type
98      procedure ListData(ObjectName : String);
99      procedure ListRoles(ObjectName : String = ''; IncludeGrants:boolean=false);
100      procedure ListGrants(ExtractTypes : TExtractTypes = []);
101 +    procedure ListPackages(PackageDDLType: TPackageDDLType; PackageName: string = ''; IncludeGrants:boolean = false);
102      procedure ListProcs(ProcDDLType: TProcDDLType = pdCreateProc; ProcedureName : String = '';
103        IncludeGrants:boolean=false);
104      procedure ListAllTables(flag : Boolean);
# Line 244 | Line 247 | const
247    obj_count = 11;
248    obj_user_group = 12;
249    obj_sql_role = 13;
250 +  obj_package = 18;
251  
252   implementation
253  
# Line 415 | Line 419 | begin
419      ListViews;
420      ListCheck;
421      ListException;
422 +    if DatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
423 +      ListPackages(paHeader);
424      ListProcs(pdCreateStub);
425      ListTriggers;
426 +    if DatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
427 +      ListPackages(paBody);
428      ListProcs(pdAlterProc);
429      ListGrants(ExtractTypes);
430    end;
# Line 659 | Line 667 | begin
667            if not qryGenerators.Eof then
668            begin
669              Column := Column + Format(' GENERATED BY DEFAULT AS IDENTITY (START WITH %d)',
670 <                     [qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInteger]);
670 >                     [qryGenerators.FieldByName('RDB$INITIAL_VALUE').AsInt64]);
671            end;
672            qryGenerators.Close;
673          end;
# Line 1056 | Line 1064 | const
1064                   'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1065                   'Order BY RDB$PROCEDURE_NAME';
1066  
1067 +  PackagesSQL = 'select * from RDB$PACKAGES '+
1068 +                 'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1069 +                 'Order BY RDB$PACKAGE_NAME';
1070 +
1071    ExceptionSQL = 'select * from RDB$EXCEPTIONS '+
1072                   'Where RDB$SYSTEM_FLAG <> 1 OR RDB$SYSTEM_FLAG IS NULL ' +
1073                   'Order BY RDB$EXCEPTION_NAME';
# Line 1203 | Line 1215 | begin
1215        qryRoles.Close;
1216      end;
1217  
1218 +    if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1219 +    begin
1220 +      qryRoles.SQL.Text := PackagesSQL;
1221 +      qryRoles.ExecQuery;
1222 +      try
1223 +        while not qryRoles.Eof do
1224 +        begin
1225 +          ShowGrants(Trim(qryRoles.FieldByName('RDB$PACKAGE_NAME').AsString), Term,
1226 +                  not (etGrantsToUser in ExtractTypes));
1227 +          qryRoles.Next;
1228 +        end;
1229 +      finally
1230 +        qryRoles.Close;
1231 +      end;
1232 +    end;
1233 +
1234      {Metadata Grants}
1235      if FDatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
1236      begin
# Line 1229 | Line 1257 | begin
1257    end;
1258   end;
1259  
1260 + procedure TIBExtract.ListPackages(PackageDDLType: TPackageDDLType;
1261 +  PackageName: string; IncludeGrants: boolean);
1262 + const
1263 +  PackageSQL = 'Select * From RDB$PACKAGES order by RDB$PACKAGE_NAME';
1264 +  PackageNameSQL = 'Select * From RDB$PACKAGES Where RDB$PACKAGE_NAME = :PackageName order by RDB$PACKAGE_NAME';
1265 +  PackageHeaderSQL = 'CREATE PACKAGE %s%sAS%s';
1266 +  PackageBodySQL = 'CREATE PACKAGE BODY %s%sAS%s';
1267 + var
1268 +  qryPackages : TIBSQL;
1269 +  Header : Boolean;
1270 +  SList : TStrings;
1271 +  aPackageName: string;
1272 + begin
1273 +  Header := true;
1274 +  qryPackages := TIBSQL.Create(FDatabase);
1275 +  SList := TStringList.Create;
1276 +  try
1277 +    if PackageName = '' then
1278 +      qryPackages.SQL.Text := PackageSQL
1279 +    else
1280 +    begin
1281 +      qryPackages.SQL.Text := PackageNameSQL;
1282 +      qryPackages.ParamByName('PackageName').AsString := PackageName;
1283 +    end;
1284 +
1285 +    qryPackages.ExecQuery;
1286 +    while not qryPackages.Eof do
1287 +    begin
1288 +      if Header then
1289 +      begin
1290 +        FMetaData.Add('COMMIT WORK;');
1291 +        FMetaData.Add('SET AUTODDL OFF;');
1292 +        FMetaData.Add(Format('SET TERM %s %s', [ProcTerm, Term]));
1293 +        FMetaData.Add(Format('%s/* Package Definitions */%s', [LineEnding, LineEnding]));
1294 +        Header := false;
1295 +      end;
1296 +
1297 +      aPackageName := qryPackages.FieldByName('RDB$PACKAGE_NAME').AsString;
1298 +      if PackageDDLType in [paHeader,paBoth] then
1299 +      begin
1300 +        FMetaData.Add(Format(PackageHeaderSQL,[aPackageName,
1301 +                                               LineEnding,LineEnding]));
1302 +        SList.Text :=  qryPackages.FieldByName('RDB$PACKAGE_HEADER_SOURCE').AsString;
1303 +        SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1304 +        FMetaData.AddStrings(SList);
1305 +      end;
1306 +
1307 +      if PackageDDLType in [paBody,paBoth] then
1308 +      begin
1309 +        FMetaData.Add(Format(PackageBodySQL,[aPackageName,
1310 +                                               LineEnding,LineEnding]));
1311 +        SList.Text :=  qryPackages.FieldByName('RDB$PACKAGE_BODY_SOURCE').AsString;
1312 +        SList.Add(Format(' %s%s', [ProcTerm, LineEnding]));
1313 +        FMetaData.AddStrings(SList);
1314 +      end;
1315 +
1316 +      if IncludeGrants then
1317 +        ShowGrantsTo(aPackageName,obj_package,ProcTerm);
1318 +      qryPackages.Next;
1319 +    end;
1320 +    qryPackages.Close;
1321 +
1322 +    if not Header then
1323 +    begin
1324 +      FMetaData.Add(Format('SET TERM %s %s', [Term, ProcTerm]));
1325 +      FMetaData.Add('COMMIT WORK;');
1326 +      FMetaData.Add('SET AUTODDL ON;');
1327 +    end;
1328 +  finally
1329 +    SList.Free;
1330 +    qryPackages.Free;
1331 +  end;
1332 + end;
1333 +
1334   {         ListAllProcs
1335    Functional description
1336          Shows text of a stored procedure given a name.
# Line 1245 | Line 1347 | procedure TIBExtract.ListProcs(ProcDDLTy
1347   const
1348    CreateProcedureStr1 = 'CREATE PROCEDURE %s ';
1349    CreateProcedureStr2 = 'BEGIN EXIT; END %s%s';
1350 +  CreateProcedureStr3 = 'BEGIN SUSPEND; EXIT; END %s%s';
1351    ProcedureSQL =  {Order procedures by dependency order and then procedure name}
1352                    'with recursive Procs as ( ' +
1353                    'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
# Line 1260 | Line 1363 | const
1363                    'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1364                    'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1365  
1366 +  ProcedureSQLODS12 =  {Order procedures by dependency order and then procedure name}
1367 +                  'with recursive Procs as ( ' +
1368 +                  'Select RDB$PROCEDURE_NAME, 1 as ProcLevel from RDB$PROCEDURES ' +
1369 +                  'UNION ALL ' +
1370 +                  'Select D.RDB$DEPENDED_ON_NAME, ProcLevel + 1 From RDB$DEPENDENCIES D ' +
1371 +                  'JOIN Procs on Procs.RDB$PROCEDURE_NAME = D.RDB$DEPENDENT_NAME ' +
1372 +                  '  and Procs.RDB$PROCEDURE_NAME <> D.RDB$DEPENDED_ON_NAME ' +
1373 +                  'JOIN RDB$PROCEDURES P On P.RDB$PROCEDURE_NAME = D.RDB$DEPENDED_ON_NAME ' +
1374 +                  '  ) ' +
1375 +                  'SELECT * FROM RDB$PROCEDURES P ' +
1376 +                  'JOIN ( ' +
1377 +                  'Select RDB$PROCEDURE_NAME, max(ProcLevel) as ProcLevel From Procs ' +
1378 +                  'Group By RDB$PROCEDURE_NAME) A On A.RDB$PROCEDURE_NAME = P.RDB$PROCEDURE_NAME ' +
1379 +                  'Where P.RDB$PACKAGE_NAME is NULL '+
1380 +                  'Order by A.ProcLevel desc, P.RDB$PROCEDURE_NAME asc';
1381    ProcedureNameSQL =
1382      'SELECT * FROM RDB$PROCEDURES ' +
1383      'WHERE RDB$PROCEDURE_NAME = :ProcedureName ' +
# Line 1278 | Line 1396 | begin
1396    SList := TStringList.Create;
1397    try
1398      if ProcedureName = '' then
1399 <      qryProcedures.SQL.Text := ProcedureSQL
1399 >    begin
1400 >      if DatabaseInfo.ODSMajorVersion < ODS_VERSION12 then
1401 >        qryProcedures.SQL.Text := ProcedureSQL
1402 >      else
1403 >        qryProcedures.SQL.Text := ProcedureSQLODS12;
1404 >    end
1405      else
1406      begin
1407        qryProcedures.SQL.Text := ProcedureNameSQL;
# Line 1304 | Line 1427 | begin
1427            FMetaData.Add(Format(CreateProcedureStr1, [QuoteIdentifier(
1428               ProcName)]));
1429            GetProcedureArgs(ProcName);
1430 <          FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1430 >          if qryProcedures.FieldByName('RDB$PROCEDURE_TYPE').AsInteger = 1 then
1431 >            FMetaData.Add(Format(CreateProcedureStr3, [ProcTerm, LineEnding]))
1432 >          else
1433 >            FMetaData.Add(Format(CreateProcedureStr2, [ProcTerm, LineEnding]));
1434          end;
1435  
1436        pdCreateProc:
# Line 2524 | Line 2650 | begin
2650            if not qryValue.EOF then
2651              FMetaData.Add(Format('ALTER SEQUENCE %s RESTART WITH %d;',
2652                   [QuoteIdentifier( GenName),
2653 <                  qryValue.FieldByName('GENERATORVALUE').AsInteger]));
2653 >                  qryValue.FieldByName('GENERATORVALUE').AsInt64]));
2654          finally
2655            qryValue.Close;
2656          end;
# Line 2893 | Line 3019 | begin
3019         if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
3020           ShowGrants(ObjectName, Term);
3021       end;
3022 +    eoPackage:
3023 +     begin
3024 +       if DatabaseInfo.ODSMajorVersion >= ODS_VERSION12 then
3025 +       begin
3026 +         ListPackages(paBoth,ObjectName, etGrant in ExtractTypes);
3027 +         if (ObjectName <> '' ) and (etGrant in ExtractTypes) then
3028 +           ShowGrants(ObjectName, Term);
3029 +       end
3030 +       else
3031 +         IBError(ibxeODSVersionRequired,['12.0']);
3032 +     end;
3033      eoFunction : ListFunctions(ObjectName);
3034      eoGenerator : ListGenerators(ObjectName,ExtractTypes);
3035      eoException : ListException(ObjectName);
# Line 3066 | Line 3203 | const
3203    '  UNION  '+
3204    '  Select RDB$COLLATION_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 17 as ObjectType  '+
3205    '  From RDB$COLLATIONS  '+
3206 +  '  UNION  '+
3207 +  '  Select RDB$PACKAGE_NAME as METAOBJECTNAME, RDB$OWNER_NAME, 18 as ObjectType  '+
3208 +  '  From RDB$PACKAGES  '+
3209    ') '+ GrantsBaseSelect;
3210  
3211    GrantsSQL =

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines