[Instantobjects-cvscommit] Source/Core InstantPump.pas,1.2,1.3 InstantCode.pas,1.5,1.6 InstantPersistence.pas,1.13,1.14

[Carlo B. <car...@us...>]

Update of /cvsroot/instantobjects/Source/Core
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22650/Source/Core

Modified Files:
	InstantCode.pas InstantPersistence.pas 
Added Files:
	InstantPump.pas 
Log Message:
VERSION 1.6.7 - Info into Readme.txt

Index: InstantPersistence.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantPersistence.pas,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** InstantPersistence.pas	11 Oct 2004 07:47:32 -0000	1.13
--- InstantPersistence.pas	17 Nov 2004 20:59:48 -0000	1.14
***************
*** 5455,5460 ****
    InstantGraphicFileFormat : TInstantGraphicFileFormat;
  begin
!   SaveDataToStream(Stream);
!   if Stream.Position <> 0 then
    begin
      Stream.Position := 0;
--- 5455,5459 ----
    InstantGraphicFileFormat : TInstantGraphicFileFormat;
  begin
!   if Stream.Size > 0 then
    begin
      Stream.Position := 0;

--- NEW FILE: InstantPump.pas ---
(*
 *   InstantObjects
 *   Database Pump
 *)

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is: InstantObjects Pump
 *
 * The Initial Developer of the Original Code is: Nando Dessena
 *
 * Portions created by the Initial Developer are Copyright (C) 2004
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit InstantPump;

interface

uses
  SysUtils, Classes, InstantPersistence;

type
  EInstantPumpError = class(Exception);

  TInstantPumpOption = (poEmptyDestBeforePump);
  TInstantPumpOptions = set of TInstantPumpOption;

const
  DefaultInstantPumpOptions = [poEmptyDestBeforePump];

type
  TInstantPump = class(TComponent)
  private
    FDestConnector: TInstantConnector;
    FSourceConnector: TInstantConnector;
    FOptions: TInstantPumpOptions;
    FBeforePump: TInstantSchemeEvent;
    FAfterPump: TInstantSchemeEvent;
    procedure SetDestConnector(const Value: TInstantConnector);
    procedure SetSourceConnector(const Value: TInstantConnector);
    procedure InternalPump(const Model: TInstantModel);
    procedure PumpAllObjects(const ClassMetadata: TInstantClassMetadata);
    procedure DeleteAllDestObjects(const ClassMetadata: TInstantClassMetadata);
  protected
    procedure CheckSourceConnector;
    procedure CheckDestConnector;
    procedure CheckConnectors;
    procedure PumpError(const ErrorMsg: string);
    procedure DoBeforePump(Scheme: TInstantScheme);
    procedure DoAfterPump(Scheme: TInstantScheme);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Pump(Model: TInstantModel = nil);
  published
    property SourceConnector: TInstantConnector
      read FSourceConnector
      write SetSourceConnector;
    property DestConnector: TInstantConnector
      read FDestConnector
      write SetDestConnector;
    property Options: TInstantPumpOptions
      read FOptions
      write FOptions
      default DefaultInstantPumpOptions;
    property BeforePump: TInstantSchemeEvent
      read FBeforePump
      write FBeforePump;
    property AfterPump: TInstantSchemeEvent
      read FAfterPump
      write FAfterPump;
  end;                           

implementation

resourcestring
  SUnassignedSourceConnector = 'SourceConnector is not assigned';
  SUnassignedDestConnector = 'DestConnector is not assigned';
  SConnectorsMustBeDifferent = 'SourceConnector cannot be equal to DestConnector';

{ TInstantPump }

constructor TInstantPump.Create(AOwner: TComponent);
begin
  inherited;
  FOptions := DefaultInstantPumpOptions;
end;

procedure TInstantPump.SetDestConnector(const Value: TInstantConnector);
begin
  if Value <> FDestConnector then begin
    if Assigned(FDestConnector) then
      FDestConnector.RemoveFreeNotification(Self);
    FDestConnector := Value;
    if Assigned(FDestConnector) then
      FDestConnector.FreeNotification(Self);
  end;
end;

procedure TInstantPump.SetSourceConnector(const Value: TInstantConnector);
begin
  if Value <> FSourceConnector then begin
    if Assigned(FSourceConnector) then
      FSourceConnector.RemoveFreeNotification(Self);
    FSourceConnector := Value;
    if Assigned(FSourceConnector) then
      FSourceConnector.FreeNotification(Self);
  end;
end;

procedure TInstantPump.CheckSourceConnector;
begin
  if not Assigned(FSourceConnector) then
    PumpError(SUnassignedSourceConnector);
end;

procedure TInstantPump.CheckDestConnector;
begin
  if not Assigned(FDestConnector) then
    PumpError(SUnassignedDestConnector);
end;

procedure TInstantPump.CheckConnectors;
begin
  CheckSourceConnector;
  CheckDestConnector;
  if FSourceConnector = FDestConnector then
    PumpError(SConnectorsMustBeDifferent);
end;

procedure TInstantPump.PumpError(const ErrorMsg: string);
begin
  raise EInstantPumpError.Create(ErrorMsg);
end;

procedure TInstantPump.Pump(Model: TInstantModel = nil);
var
  Scheme: TInstantScheme;
begin
  CheckConnectors;
  SourceConnector.Connect;
  try
    DestConnector.Connect;
    try
      if Model = nil then
        Model := InstantModel;
      Scheme := FSourceConnector.CreateScheme(Model);
      try
        DoBeforePump(Scheme);
        InternalPump(Model);
        DoAfterPump(Scheme);
      finally
        Scheme.Free;
      end;
    finally
      DestConnector.Disconnect;
    end;
  finally
    SourceConnector.Disconnect;
  end;
end;

procedure TInstantPump.DoBeforePump(Scheme: TInstantScheme);
begin
  if Assigned(FBeforePump) then
    FBeforePump(Self, Scheme);
end;

procedure TInstantPump.DoAfterPump(Scheme: TInstantScheme);
begin
  if Assigned(FAfterPump) then
    FAfterPump(Self, Scheme);
end;

procedure TInstantPump.InternalPump(const Model: TInstantModel);
var
  I: Integer;
  ClassMetadata: TInstantClassMetadata;
begin
  FDestConnector.StartTransaction;
  try
    for I := 0 to Pred(Model.ClassMetadatas.Count) do begin
      ClassMetadata := Model.ClassMetadatas[I];
      if ClassMetadata.IsStored then begin
        if poEmptyDestBeforePump in FOptions then
          DeleteAllDestObjects(ClassMetadata);
        PumpAllObjects(ClassMetadata);
      end;
    end;
    FDestConnector.CommitTransaction;
  except
    FDestConnector.RollbackTransaction;
    raise;
  end;
end;

procedure TInstantPump.PumpAllObjects(const ClassMetadata: TInstantClassMetadata);
var
  Query : TInstantQuery;
  SourceObject, DestObject: TInstantObject;
  i : integer;
begin
  Query := FSourceConnector.CreateQuery;
  try
    Query.Command := 'select * from ' + ClassMetadata.Name + ' order by Id';
    Query.Open;
    for i := 0 to Query.ObjectCount -1 do
    begin
      SourceObject :=  Query.Objects[i] as TInstantObject;
      DestObject := TInstantObjectClass(Query.ObjectClass).Clone(SourceObject, FDestConnector);
      DestObject.Store;
    end;
  finally
    Query.Close;
    Query.Free;
  end;
end;

procedure TInstantPump.DeleteAllDestObjects(const ClassMetadata: TInstantClassMetadata);
var
  Query: TInstantQuery;
  i : integer;
begin
  Query := FDestConnector.CreateQuery;
  try
    Query.Command := 'select * from ' + ClassMetadata.Name + ' order by Id';
    Query.Open;
    for i := 0 to Query.ObjectCount -1 do
    begin
      if (Query.Objects[i] is TInstantObject) then
        TInstantObject(Query.Objects[i]).Dispose;
    end;    
  finally
    Query.Close;
    Query.Free;
  end;
end;

procedure TInstantPump.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if AComponent = FSourceConnector then
      FSourceConnector := nil;
    if AComponent = FDestConnector then
      FDestConnector := nil;
  end;
end;

end.

Index: InstantCode.pas
===================================================================
RCS file: /cvsroot/instantobjects/Source/Core/InstantCode.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** InstantCode.pas	30 Sep 2004 15:27:54 -0000	1.5
--- InstantCode.pas	17 Nov 2004 20:59:48 -0000	1.6
***************
*** 28,31 ****
--- 28,33 ----
   * Nando Dessena, Andrea Petrelli:
   * - ExternalPart, ExternalParts and ExternalReferences support
+  * Steven Mitchell:
+  * - Added MetadataInfo identification tag
   * ***** END LICENSE BLOCK ***** *)
  
***************
*** 1530,1533 ****
--- 1532,1536 ----
  {$ENDIF}
  
+   MetadataInfoID = 'IOMETADATA';       
    MetaKeyDefault = 'default';
    MetaKeyExternalStored = 'externalstored';
***************
*** 4429,4434 ****
--- 4432,4450 ----
  class function TInstantCodeMetadataInfo.InternalAtInstance(
    Reader: TInstantCodeReader; out Name: string): Boolean;
+ var
+   SavePos: TInstantCodePos;
  begin
    Result := Reader.NextChar = '{';
+   if not Result then
+   begin
+     SavePos := Reader.Position;
+     try
+       Reader.IgnoreComments := False;
+       result := Reader.ReadMatching('{' + MetadataInfoID + ' ');
+     finally
+       Reader.IgnoreComments := True;
+       Reader.Position := SavePos;
+     end;
+   end;
  end;
  
***************
*** 4442,4445 ****
--- 4458,4465 ----
    if not Reader.EnterComment then
      Reader.ErrorExpected('{');
+ 
+   if SameText(Reader.NextToken, MetadataInfoID) then
+     Reader.ReadToken;
+ 
    Persistence := peEmbedded;
    SaveErrorSeverity := Reader.ErrorSeverity;
***************
*** 4483,4487 ****
    Start, I: Integer;
  begin
!   Writer.Write('{ ');
    try
      S := ClassStatement;
--- 4503,4507 ----
    Start, I: Integer;
  begin
!   Writer.Write('{' + MetadataInfoID + ' ');   
    try
      S := ClassStatement;