File: monitorcfg.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (232 lines) | stat: -rw-r--r-- 5,944 bytes parent folder | download | duplicates (10)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
unit MonitorCfg;

{$mode objfpc}{$H+}

interface

uses
  sysutils, strutils, contnrs, dom, xmlread;
  
type
  TServerType = (stFtp, stHttp);
  
  TServer = class;
  TFile = class;
  
  TReplaceStringEvent = function (const value: string):string of object;
  
  { TMonitorConfig }

  TMonitorConfig = class
  private
    FFileName: string;
    FFPCDevelVersion: string;
    FFPCFixesVersion: string;
    FFPCReleaseVersion: string;
    FLazVersion: string;
    FServers: TFPObjectList;
    function GetServer(index: integer): TServer;
    function GetServerCount: integer;
    procedure AddServer(const ServerNode: TDOMNode);
    procedure ReadVersions(const VersionNode: TDOMNode);
    function ServerReplaceString(const value: string): string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Load(const AFileName: string);
    procedure AddServer(AServer: TServer);
    property FileName: string read FFileName write FFileName;
    property LazVersion: string read FLazVersion;
    property FPCReleaseVersion: string read FFPCReleaseVersion;
    property FPCFixesVersion: string read FFPCFixesVersion;
    property FPCDevelVersion: string read FFPCDevelVersion;
    property Servers[index: integer] : TServer read GetServer;
    property ServerCount: integer read GetServerCount;
  end;

  { TServer }

  TServer = class
  private
    FFiles: TFPObjectList;
    FDescription: string;
    FOnReplaceString: TReplaceStringEvent;
    FServerType: TServerType;
    function GetFile(index: integer): TFile;
    function GetFileCount: integer;
    procedure AddFile(const ServerNode: TDOMNode);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddFile(AFile: TFile);
    property Description : string read FDescription write FDescription;
    property ServerType : TServerType read FServerType write FServerType;
    property Files[index: integer] : TFile read GetFile;
    property FileCount: integer read GetFileCount;
    property OnReplaceString: TReplaceStringEvent read FOnReplaceString write FOnReplaceString;
  end;

  { TFile }

  TFile = class
  private
    FDescription: string;
    FMask: string;
    FUpdated: boolean;
  public
    constructor Create;
    property Mask: string read FMask write FMask;
    property Description: string read FDescription write FDescription;
    property Updated: boolean read FUpdated write FUpdated;
  end;

implementation

function GetAttributeValue(const ANode: TDomNode; const AName: string): string;
var
  Attribute: TDOMNode;
begin
  Attribute := ANode.Attributes.GetNamedItem(AName);
  if assigned(Attribute) then
    Result := Attribute.NodeValue;
end;

{ TServer }

function TServer.GetFile(index: integer): TFile;
begin
  Result := TFile(FFiles[index]);
end;

function TServer.GetFileCount: integer;
begin
  Result := FFiles.Count;
end;

procedure TServer.AddFile(const ServerNode: TDOMNode);
var
  NewFile: TFile;
begin
  NewFile := TFile.Create;
  NewFile.Description := OnReplaceString(GetAttributeValue(ServerNode, 'Description'));
  NewFile.Mask := OnReplaceString(GetAttributeValue(ServerNode, 'Mask'));
  NewFile.Updated := StrToBoolDef(GetAttributeValue(ServerNode, 'Updated'), true);
  AddFile(NewFile);
end;

constructor TServer.Create;
begin
  FFiles := TFPObjectList.Create;
end;

destructor TServer.Destroy;
begin
  FFiles.Free;
  inherited Destroy;
end;

procedure TServer.AddFile(AFile: TFile);
begin
  FFiles.Add(AFile);
end;

{ TFile }

constructor TFile.Create;
begin
end;

{ TMonitorConfig }

function TMonitorConfig.GetServer(index: integer): TServer;
begin
  Result := TServer(FServers[index]);
end;

function TMonitorConfig.GetServerCount: integer;
begin
  Result := FServers.Count;
end;

procedure TMonitorConfig.AddServer(const ServerNode: TDOMNode);
var
  Server: TServer;
  Attribute: TDOMNode;
  Node: TDomNode;
begin
  Server := TServer.Create;
  Server.OnReplaceString := @ServerReplaceString;
  Attribute := ServerNode.Attributes.GetNamedItem('Name');
  if assigned(Attribute) then
    Server.Description := Attribute.NodeValue;
  Attribute := ServerNode.Attributes.GetNamedItem('Type');
  if assigned(Attribute) then
    if Attribute.NodeValue='ftp' then
      Server.ServerType := stFtp
    else if Attribute.NodeValue='http' then
      Server.ServerType := stHttp;
  Node := ServerNode.FirstChild;
  while Node<>nil do begin
    if Node.NodeName='File' then
      Server.AddFile(Node);
    Node := Node.NextSibling;
  end;
  AddServer(Server);
end;

procedure TMonitorConfig.ReadVersions(const VersionNode: TDOMNode);
begin
  FLazVersion := GetAttributeValue(VersionNode, 'Lazarus');
  FFPCReleaseVersion := GetAttributeValue(VersionNode, 'FPC_Release');
  FFPCFixesVersion := GetAttributeValue(VersionNode, 'FPC_Fixes');
  FFPCDevelVersion := GetAttributeValue(VersionNode, 'FPC_Devel');
end;

function TMonitorConfig.ServerReplaceString(const value: string): string;
begin
  Result := AnsiReplaceStr(Value, '$LAZVER', LazVersion);
  Result := AnsiReplaceStr(Result, '$FPCRELEASEVER', FPCReleaseVersion);
  Result := AnsiReplaceStr(Result, '$FPCFIXESVER', FPCFixesVersion);
  Result := AnsiReplaceStr(Result, '$FPCDEVELVER', FPCDevelVersion);
end;

constructor TMonitorConfig.Create;
begin
  FServers := TFPObjectList.Create;
end;

destructor TMonitorConfig.Destroy;
begin
  FServers.Free;
  inherited Destroy;
end;

procedure TMonitorConfig.Load(const AFileName: string);
var
  XmlDoc: TXMLDocument;
  Node: TDomNode;
begin
  FFileName := AFileName;
  XmlDoc := nil;
  try
    ReadXMLFile(XmlDoc, FileName);
    Node := XmlDoc.DocumentElement.FirstChild;
    while Node<>nil do begin
      if Node.NodeName='Server' then
        AddServer(Node)
      else if Node.NodeName='Version' then
        ReadVersions(Node);
      Node := Node.NextSibling;
    end;
  finally
    XmlDoc.Free;
  end;
end;

procedure TMonitorConfig.AddServer(AServer: TServer);
begin
  FServers.Add(AServer);
end;

end.