1 {
2 This file is part of the Free Pascal Class Library SDO Implementation
3 Copyright (c) 2012 by Inoussa OUEDRAOGO
4 Free Pascal development team
5
6 This unit implements a streaming interface
7
8 See the file COPYING.FPC, included in this distribution,
9 for details about the copyright.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 **********************************************************************}
16 {$INCLUDE sdo_global.inc}
17 unit sdo_serialization_utils;
18
19 interface
20 uses
21 SysUtils, Classes, Contnrs,
22 sdo_types, sdo;
23
24 type
25
26 TScopeType = ( stObject, stArray );
27 TArrayStyle = ( asScoped, asEmbeded, asNone );
28
29 ESDOSerializationException = class(ESDOException) end;
30
31 TSerializationStyle = ( ssNodeSerialization, ssAttibuteSerialization );
32 TNameStyle = ( nsUnqualified, nsQualified );
33
34 TStreamBookmark = class(TObject)
35 end;
36
37 ISDOSerializerStream = interface
38 ['{3C38D6E1-C4BE-4BFC-B16A-BD8A1A09A5E6}']
GetFormatNamenull39 function GetFormatName() : string;
40 procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
GetSerializationStylenull41 function GetSerializationStyle():TSerializationStyle;
42 procedure SetNameStyle(const AValue : TNameStyle);
GetNameStylenull43 function GetNameStyle() : TNameStyle;
GetCurrentScopenull44 function GetCurrentScope():string;
45 procedure Clear();
46 procedure Initialize();
47
48 procedure BeginObject(
49 Const AName : string;
50 Const ATypeInfo : ISDOType
51 );
52 procedure BeginArray(
53 const AName : string;
54 const AItemTypeInfo : ISDOType;
55 const ABounds : array of Integer
56 );
57 procedure NilCurrentScope();
IsCurrentScopeNilnull58 function IsCurrentScopeNil():Boolean;
59 procedure EndScope();
BeginObjectReadnull60 function BeginObjectRead(
61 var AScopeName : string;
62 const ATypeInfo : ISDOType
63 ) : Integer;
BeginArrayReadnull64 function BeginArrayRead(
65 var AScopeName : string;
66 const ATypeInfo : ISDOType;
67 const AItemName : string
68 ):Integer;
GetScopeItemNamesnull69 function GetScopeItemNames(
70 const AItemStyle : TSerializationStyle;
71 const AReturnList : TStrings
72 ) : Integer;
73 procedure EndScopeRead();
74
75 procedure Put(
76 const AName : string;
77 const ATypeInfo : ISDOType;
78 const AData
79 );overload;
80 procedure Put(
81 const ANameSpace,
82 AName : string;
83 const ATypeInfo : ISDOType;
84 const AData
85 );overload;
86 procedure PutScopeInnerValue(
87 const ATypeInfo : ISDOType;
88 const AData
89 );
Getnull90 function Get(
91 const ATypeInfo : ISDOType;
92 var AName : string;
93 var AData
94 ) : Boolean;overload;
Getnull95 function Get(
96 const ANameSpace : string;
97 const ATypeInfo : ISDOType;
98 var AName : string;
99 var AData
100 ) : Boolean;overload;
GetScopeInnerValuenull101 function GetScopeInnerValue(
102 const ATypeInfo : ISDOType;
103 var AData
104 ) : Boolean;
ReadBuffernull105 function ReadBuffer(const AName : string) : string;
106 //Please use this method if and _only_ if you do not have another way to achieve your aim!
107 procedure WriteBuffer(const AValue : string);
108
109 procedure SaveToStream(AStream : TStream);overload;
110 procedure SaveToFile(const AFileName : string);overload;
111 procedure LoadFromStream(AStream : TStream);overload;
112 procedure LoadFromFile(const AFileName : string);overload;
113
GetBookMarknull114 function GetBookMark() : TStreamBookmark;
GotoBookmarknull115 function GotoBookmark(const AValue : TStreamBookmark) : Boolean;
116 // This procedures will raise exceptions!!!
117 procedure Error(Const AMsg:string);overload;
118 procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
119 end;
120
121 TObjectStackExCopyFunc = function (const AItem : TObject) : TObject;
122 TObjectStackEx = class(TObjectStack)
123 public
Clonenull124 function Clone(const ACopyFunc : TObjectStackExCopyFunc) : TObjectStackEx;
125 end;
126
127 //resourcestring
128 //SMSG_InvalidBookmark = 'Invalid bookmark.';
129
130 implementation
131
132 { TObjectStackEx }
133
TObjectStackEx.Clonenull134 function TObjectStackEx.Clone(const ACopyFunc : TObjectStackExCopyFunc) : TObjectStackEx;
135 var
136 i, c : PtrInt;
137 rls , sls : TList;
138 begin
139 Result := TObjectStackEx.Create();
140 try
141 sls := List;
142 c := sls.Count;
143 if ( c > 0 ) then begin
144 rls := Result.List;
145 rls.Capacity := sls.Capacity;
146 for i := 0 to Pred(c) do
147 rls.Add(ACopyFunc(TObject(sls[i])));
148 end;
149 except
150 FreeAndNil(Result);
151 raise;
152 end
153 end;
154
155 end.
156