Commits

Anonymous committed 7050a96

Add OnLoadError event.

Improve error handling and reporting.
(I think, I'm really committing this 2013-08-27!
can't believe how these changes have been in hiding for so long..)

  • Participants
  • Parent commits 2dcdb4f

Comments (0)

Files changed (1)

File Src/ASConfig.pas

   TStoreProperty = TMemberVisibility;
   TStoreProperties = set of TStoreProperty;
 
+  TLoadErrorEvent = procedure(Sender: TObject; Target: TObject; Error: Exception; var Retry: Boolean) of object;
+
   TASCustomConfig = class(TComponent)
   private
     FParentConfig: TASCustomConfig;
     FIncludeRegExs: TPerlRegExList;
     FExcludeRegExs: TPerlRegExList;
     FCheckIsStored: Boolean;
+    FOnLoadError: TLoadErrorEvent;
 
     function GetStorePublic: Boolean;
     function GetStorePublished: Boolean;
     procedure SetIncludePropertyNames(const Value: TStrings);
     procedure SetExcludePropertyNames(const Value: TStrings);
 
+    function DoOnLoadError(Target: TObject; E: Exception): Boolean;
+
     function MatchName(const Prefix: string; const Name: string; RegEx: TPerlRegExList): Boolean;
 
     procedure InitilizeRegExs(const Section: string);
     property StoreProperties: TStoreProperties read FStoreProperties write FStoreProperties default [mvPublished];
     property StorePublic: Boolean read GetStorePublic write SetStorePublic;
     property StorePublished: Boolean read GetStorePublished write SetStorePublished;
+
+    property OnLoadError: TLoadErrorEvent read FOnLoadError write FOnLoadError;
   end;
 
   TASCustomConfigIniFile = class(TASCustomConfig)
     FFileName: string;
     FSection: string;
     FSkipWriteIfNotModified: Boolean;
+    function GetIniFile: IASConfigFile;
 
   protected
     procedure SetParentConfig(const Value: TASCustomConfig); override;
     function LoadEnum(const Name: string; const Default: TValue): TValue;
 
     function CreateIniFile: TCustomIniFile; virtual;
+    function CreateConfigFile: IASConfigFile; virtual;
     procedure ClearIniFile; virtual;
     procedure OpenIniFile(const Section: string); virtual;
     procedure CloseIniFile; virtual;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Clear(ClearParents: Boolean = False); override;
-    property IniFile: IASConfigFile read FIniFile;
+    property IniFile: IASConfigFile read GetIniFile;
     property FileName: string read FFileName write FFileName;
     property SkipWriteIfNotModified: Boolean read FSkipWriteIfNotModified write FSkipWriteIfNotModified default True;
   end;
     property SearchPath;
     property SkipWriteIfNotModified;
     property StoreProperties;
+    property OnLoadError;
   end;
 
   TASConfigRegistryIniFile = class(TASCustomConfigRegistryIniFile)
     property SearchPath;
     property SkipWriteIfNotModified;
     property StoreProperties;
+    property OnLoadError;
   end;
 
   TASConfigStore = class(TComponent)
   private
     FConfig: TASCustomConfig;
     FOnConfigChange: TNotifyEvent;
+    FOnLoadError: TLoadErrorEvent;
     procedure DoOnConfigChange;
     procedure SetConfig(const Value: TASCustomConfig);
+    procedure SetOnLoadError(const Value: TLoadErrorEvent);
   public
     procedure Save(const Obj: TComponent); overload;
     procedure Save(const Obj: TObject; const Path: string = 'Default'); overload;
   published
     property Config: TASCustomConfig read FConfig write SetConfig;
     property OnConfigChange: TNotifyEvent read FOnConfigChange write FOnConfigChange;
+    property OnLoadError: TLoadErrorEvent read FOnLoadError write SetOnLoadError;
   end;
 
 procedure Register;
   inherited;
 end;
 
+function TASCustomConfig.DoOnLoadError(Target: TObject; E: Exception): Boolean;
+begin
+  Result := False;
+  if Assigned(FOnLoadError) then
+    FOnLoadError(Self, Target, E, Result);
+end;
+
 procedure TASCustomConfig.FinalizeRegExs;
   procedure FinalizeList(var L: TPerlRegExList);
   begin
 procedure TASCustomConfig.LoadCollection(const Prefix: string; const Collection: TCollection);
 var
   I, Count: Integer;
+
+  function GetItem: TCollectionItem;
+  begin
+    if Collection.Count > I then
+      Result := Collection.Items[I]
+    else
+      Result := Collection.Add;
+  end;
+
 begin
   Count := LoadMethodMap[tkInteger](Prefix + 'Count', TValue.From(0)).AsInteger;
   for I := 0 to Count - 1 do
-    LoadObject(Prefix + IntToStr(I) + '.', Collection.Add);
+    LoadObject(Prefix + IntToStr(I) + '.', GetItem);
+
+  while Collection.Count > Count do
+    Collection.Delete(Count);
 end;
 
 procedure TASCustomConfig.LoadObject(const Prefix: string; const Obj: TObject);
       if Assigned(L) then begin
         if P.PropertyType.TypeKind = tkClass then
           L(Prefix + P.Name, P.GetValue(Obj))
-        else
+        else while True do try
           P.SetValue(Obj, L(Prefix + P.Name, P.GetValue(Obj)));
+          Break;
+        except
+          on E: Exception do if not DoOnLoadError(Obj, E) then
+            Break;
+        end;
       end;
     end;
   finally
   try
     T := Ctx.GetType(Obj.ClassType);
     for P in GetProperties(T) do begin
-      if not P.IsReadable then
+      if not (P.IsReadable and (P.IsWritable or (P.PropertyType.TypeKind = tkClass))) then
         Continue;
 
       if not MatchName(Prefix, P.Name, FIncludeRegExs) then begin
 //  RegisterLoadMethod(tkProcedure   , nil);
 end;
 
+function TASCustomConfigIniFile.CreateConfigFile: IASConfigFile;
+var
+  Parent: IASConfigFile;
+begin
+  if Assigned(FParentConfig) and (ParentConfig is TASCustomConfigIniFile) then
+    Parent := TASCustomConfigIniFile(ParentConfig).IniFile;
+
+  Result := TASConfigIniFileEx.Create(Name, CreateIniFile, Parent);
+
+  with Result do begin
+    SkipWriteIfNotModified := SkipWriteIfNotModified;
+    SearchPath := SearchPath;
+  end;
+end;
+
 function TASCustomConfigIniFile.CreateIniFile: TCustomIniFile;
 begin
   Result := TIniFile.Create(FileName);
 end;
 
+function TASCustomConfigIniFile.GetIniFile: IASConfigFile;
+begin
+  Result := FIniFile;
+  if not Assigned(Result) then
+    Result := CreateConfigFile;
+end;
+
 function TASCustomConfigIniFile.LoadEnum(const Name: string; const Default: TValue): TValue;
 var
   I: Integer;
 end;
 
 procedure TASCustomConfigIniFile.OpenIniFile(const Section: string);
-var
-  Parent: IASConfigFile;
 begin
   if Assigned(FIniFile) then
     CloseIniFile;
 
-  if Assigned(FParentConfig) and (ParentConfig is TASCustomConfigIniFile) then
-    Parent := TASCustomConfigIniFile(ParentConfig).IniFile;
-
   Self.Section := Section;
-  FIniFile := TASConfigIniFileEx.Create(Name, CreateIniFile, Parent);
-  IniFile.SkipWriteIfNotModified := SkipWriteIfNotModified;
-  IniFile.SearchPath := SearchPath;
+  FIniFile := CreateConfigFile;
 end;
 
 procedure TASCustomConfigIniFile.SaveEnum(const Name: string; const Value: TValue);
 
 procedure TASConfigStore.Load(const Obj: TObject; const Path: string);
 begin
-  Assert(Assigned(Config), 'No config file assigned to store');
+  Assert(Assigned(Config), 'No config file assigned to store: ' + Name);
   Config.Load(Obj, Path);
 end;
 
 
 procedure TASConfigStore.Save(const Obj: TObject; const Path: string);
 begin
-  Assert(Assigned(Config), 'No config file assigned to store');
+  Assert(Assigned(Config), 'No config file assigned to store: ' + Name);
   Config.Save(Obj, Path);
 end;
 
 begin
   if FConfig <> Value then begin
     FConfig := Value;
+    if Assigned(FConfig) and not Assigned(FConfig.OnLoadError) then
+      FConfig.OnLoadError := OnLoadError;
+
     DoOnConfigChange;
   end;
 end;
 
+procedure TASConfigStore.SetOnLoadError(const Value: TLoadErrorEvent);
+begin
+  if Assigned(Config) then
+    Config.OnLoadError := Value;
+
+  FOnLoadError := Value;
+end;
+
 { TASCustomConfigRegistry }
 
 procedure TASCustomConfigRegistryIniFile.ClearIniFile;