1 | unit UProject;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils,
|
---|
9 | LazFileUtils;
|
---|
10 |
|
---|
11 | type
|
---|
12 |
|
---|
13 | { TProject }
|
---|
14 |
|
---|
15 | TProject = class
|
---|
16 | private
|
---|
17 | FBackend: TBackend;
|
---|
18 | function GetDirectory: string;
|
---|
19 | function GetRepositoryURL: string;
|
---|
20 | procedure SetDirectory(AValue: string);
|
---|
21 | procedure SetRepositoryURL(AValue: string);
|
---|
22 | procedure SetBackend(AValue: TBackend);
|
---|
23 | public
|
---|
24 | WorkingCopy: TWorkingCopy;
|
---|
25 | Repository: TRepository;
|
---|
26 | procedure Open(Directory: string);
|
---|
27 | constructor Create;
|
---|
28 | destructor Destroy; override;
|
---|
29 | procedure LoadXMLNOde(Node: TDOMNode);
|
---|
30 | procedure SaveXMLNOde(Node: TDOMNode);
|
---|
31 | property Backend: TBackend read FBackend write SetBackend;
|
---|
32 | property Directory: string read GetDirectory write SetDirectory;
|
---|
33 | property RepositoryURL: string read GetRepositoryURL write SetRepositoryURL;
|
---|
34 | end;
|
---|
35 |
|
---|
36 | { TProjects }
|
---|
37 |
|
---|
38 | TProjects = class(TObjectList)
|
---|
39 | procedure LoadXMLNode(Node: TDOMNode);
|
---|
40 | procedure SaveXMLNode(Node: TDOMNode);
|
---|
41 | end;
|
---|
42 |
|
---|
43 | { TProjectGroup }
|
---|
44 |
|
---|
45 | TProjectGroup = class
|
---|
46 | FileName: string;
|
---|
47 | Projects: TProjects;
|
---|
48 | constructor Create;
|
---|
49 | destructor Destroy; override;
|
---|
50 | procedure LoadFromFile(FileName: string);
|
---|
51 | procedure SaveToFile(FileName: string);
|
---|
52 | end;
|
---|
53 |
|
---|
54 |
|
---|
55 | implementation
|
---|
56 |
|
---|
57 | resourcestring
|
---|
58 | SWrongFileFormat = 'Wrong file format';
|
---|
59 |
|
---|
60 | { TProjects }
|
---|
61 |
|
---|
62 | procedure TProjects.LoadXMLNode(Node: TDOMNode);
|
---|
63 | var
|
---|
64 | NewProject: TProject;
|
---|
65 | Node2: TDOMNode;
|
---|
66 | begin
|
---|
67 | Node2 := Node.FirstChild;
|
---|
68 | while Assigned(Node2) and (Node2.NodeName = 'Project') do begin
|
---|
69 | NewProject := TProject.Create;
|
---|
70 | NewProject.LoadXMLNode(Node2);
|
---|
71 | Add(NewProject);
|
---|
72 | Node2 := Node2.NextSibling;
|
---|
73 | end;
|
---|
74 | end;
|
---|
75 |
|
---|
76 | procedure TProjects.SaveXMLNode(Node: TDOMNode);
|
---|
77 | var
|
---|
78 | I: Integer;
|
---|
79 | NewNode: TDOMNode;
|
---|
80 | begin
|
---|
81 | for I := 0 to Count - 1 do begin;
|
---|
82 | NewNode := Node.OwnerDocument.CreateElement('Project');
|
---|
83 | Node.AppendChild(NewNode);
|
---|
84 | TProject(Items[I]).SaveXMLNode(NewNode);
|
---|
85 | end;
|
---|
86 | end;
|
---|
87 |
|
---|
88 |
|
---|
89 | { TProjectGroup }
|
---|
90 |
|
---|
91 | constructor TProjectGroup.Create;
|
---|
92 | begin
|
---|
93 | Projects := TProjects.Create;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | destructor TProjectGroup.Destroy;
|
---|
97 | begin
|
---|
98 | Projects.Free;
|
---|
99 | inherited Destroy;
|
---|
100 | end;
|
---|
101 |
|
---|
102 | procedure TProjectGroup.LoadFromFile(FileName: string);
|
---|
103 | var
|
---|
104 | Doc: TXMLDocument;
|
---|
105 | RootNode: TDOMNode;
|
---|
106 | Node: TDOMNode;
|
---|
107 | Node2: TDOMNode;
|
---|
108 | begin
|
---|
109 | Self.FileName := FileName;
|
---|
110 | ReadXMLFile(Doc, UTF8Decode(FileName));
|
---|
111 | with Doc do try
|
---|
112 | if Doc.DocumentElement.NodeName <> 'ProjectGroup' then
|
---|
113 | raise Exception.Create(SWrongFileFormat);
|
---|
114 | RootNode := Doc.DocumentElement;
|
---|
115 | with RootNode do begin
|
---|
116 | Node := FindNode('Projects');
|
---|
117 | if Assigned(Node) then Projects.LoadXMLNode(Node);
|
---|
118 | end;
|
---|
119 | finally
|
---|
120 | Doc.Free;
|
---|
121 | end;
|
---|
122 | end;
|
---|
123 |
|
---|
124 | procedure TProjectGroup.SaveToFile(FileName: string);
|
---|
125 | var
|
---|
126 | NewNode: TDOMNode;
|
---|
127 | Doc: TXMLDocument;
|
---|
128 | RootNode: TDOMNode;
|
---|
129 | begin
|
---|
130 | if FileName = '' then Exit;
|
---|
131 | Self.FileName := FileName;
|
---|
132 | Doc := TXMLDocument.Create;
|
---|
133 | with Doc do try
|
---|
134 | RootNode := CreateElement('ProjectGroup');
|
---|
135 | AppendChild(RootNode);
|
---|
136 | with RootNode do begin
|
---|
137 | NewNode := OwnerDocument.CreateElement('Projects');
|
---|
138 | AppendChild(NewNode);
|
---|
139 | Projects.SaveXMLNode(NewNode);
|
---|
140 | end;
|
---|
141 | ForceDirectoriesUTF8(ExtractFileDir(FileName));
|
---|
142 | WriteXMLFile(Doc, UTF8Decode(FileName));
|
---|
143 | finally
|
---|
144 | Doc.Free;
|
---|
145 | end;
|
---|
146 | end;
|
---|
147 |
|
---|
148 | { TProject }
|
---|
149 |
|
---|
150 | procedure TProject.SetBackend(AValue: TBackend);
|
---|
151 | begin
|
---|
152 | if FBackend = AValue then Exit;
|
---|
153 | FBackend := AValue;
|
---|
154 | FreeAndNil(WorkingCopy);
|
---|
155 | WorkingCopy := AValue.WorkingCopyClass.Create;
|
---|
156 | FreeAndNil(Repository);
|
---|
157 | Repository := AValue.RepositoryClass.Create;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | function TProject.GetDirectory: string;
|
---|
161 | begin
|
---|
162 | Result := WorkingCopy.Path;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | function TProject.GetRepositoryURL: string;
|
---|
166 | begin
|
---|
167 | Result := WorkingCopy.RepositoryURL;
|
---|
168 | end;
|
---|
169 |
|
---|
170 | procedure TProject.SetDirectory(AValue: string);
|
---|
171 | begin
|
---|
172 | WorkingCopy.Path := AValue;
|
---|
173 | end;
|
---|
174 |
|
---|
175 | procedure TProject.SetRepositoryURL(AValue: string);
|
---|
176 | begin
|
---|
177 | WorkingCopy.RepositoryURL := AValue;
|
---|
178 | Repository.Path := AValue;
|
---|
179 | end;
|
---|
180 |
|
---|
181 | procedure TProject.Open(Directory: string);
|
---|
182 | begin
|
---|
183 | WorkingCopy.Path := Directory;
|
---|
184 | end;
|
---|
185 |
|
---|
186 | constructor TProject.Create;
|
---|
187 | begin
|
---|
188 | WorkingCopy := TWorkingCopy.Create;
|
---|
189 | Repository := TRepository.Create;
|
---|
190 | end;
|
---|
191 |
|
---|
192 | destructor TProject.Destroy;
|
---|
193 | begin
|
---|
194 | WorkingCopy.Free;
|
---|
195 | Repository.Free;
|
---|
196 | inherited Destroy;
|
---|
197 | end;
|
---|
198 |
|
---|
199 | procedure TProject.LoadXMLNOde(Node: TDOMNode);
|
---|
200 | begin
|
---|
201 | RepositoryURL := ReadString(Node, 'RepositoryURL', '');
|
---|
202 | Directory := ReadString(Node, 'Directory', '');
|
---|
203 | end;
|
---|
204 |
|
---|
205 | procedure TProject.SaveXMLNOde(Node: TDOMNode);
|
---|
206 | begin
|
---|
207 | WriteString(Node, 'RepositoryURL', RepositoryURL);
|
---|
208 | WriteString(Node, 'Directory', Directory);
|
---|
209 | end;
|
---|
210 |
|
---|
211 | end.
|
---|
212 |
|
---|