pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fixlp: new utility program to convert Lazarus xml files written by v2.1+ to older versions.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7603 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-08-14 14:32:10 +00:00
parent 123e934a4f
commit 4109836a16
3 changed files with 255 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
applications/fixlp/README.txt Normal file
View File

@ -0,0 +1,24 @@
-------------------------------------------------------------------------------
fixlp
-------------------------------------------------------------------------------
In Lazarus v2.1 a new structure of the xml files (*.lpi, *.lps, *.lpk) was
introduced. It replaces the numbered xml nodes used in older versions by
unnumbered nodes.
While Lazarus v2.1 can read both types of file formats and can also convert
between them, older versions cannot read the new structure correctly leading
to a lot of difficult-to-understand errors when trying to compile.
fixlp is a small utility program for Lazarus versions before v2.1 and
converts the new Lazarus xml file format to the format used by older
versions.
Syntax:
fixlp <filename1> [, <filename2> [, ...]]
<filename1,2,...> are the names of the Lazarus .lpi, .lps or .lpk files
(with absolute or relative path) to be converted.
Wildcards are allowed.

69
applications/fixlp/fixlp.lpi Normal file
View File

@ -0,0 +1,69 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="fixlp"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="fixlp.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fixlp"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

162
applications/fixlp/fixlp.lpr Normal file
View File

@ -0,0 +1,162 @@
program fixlp;
uses
SysUtils, Classes, FileUtil, laz2_xmlread, laz2_xmlwrite, laz2_dom;
const
PARENTS_OF_NUMBERED_NODES: array[0..9] of string = (
'BuildModes', 'RequiredPackages', 'RequiredPkgs', 'Files', 'Units',
'Exceptions', 'JumpHistory', 'Modes', 'HistoryLists', 'OtherDefines'
);
{ Rename the given node. ANode.NodeName is readonly. Therefore, we create
a new empty node, give it the new name and copy all children and attributes
from the old node to the new node.
NOTE:
We cannot call parentNode.CloneNode because this would copy the node name
--> we must do everything manually step by step. }
procedure RenameNode(ANode: TDOMNode; ANewName: String);
var
doc: TDOMDocument;
parentNode: TDOMNode;
newNode: TDOMNode;
childNode: TDOMNode;
newChildNode: TDOMNode;
i: Integer;
begin
parentNode := ANode.ParentNode;
doc := ANode.OwnerDocument;
// Create a new node
newNode := doc.CreateElement(ANewName);
// copy children of old node to new node
childNode := ANode.FirstChild;
while childNode <> nil do begin
newChildNode := childNode.CloneNode(true);
newNode.AppendChild(newChildNode);
childNode := childNode.NextSibling;
end;
// Copy attributes to the new node
for i := 0 to ANode.Attributes.Length - 1 do
TDOMElement(newNode).SetAttribute(
ANode.Attributes[i].NodeName,
ANode.Attributes[i].NodeValue
);
// Replace old node by new node in xml document
parentNode.Replacechild(newNode, ANode);
// Destroy old node
ANode.Free;
end;
procedure FixNode(ANode: TDOMNode);
var
nodeName: String;
subnode: TDOMNode;
nextSubNode: TDOMNode;
numItems: Integer;
i: Integer;
found: Boolean;
begin
if ANode = nil then
exit;
nodeName := ANode.NodeName;
found := false;
for i := Low(PARENTS_OF_NUMBERED_NODES) to High(PARENTS_OF_NUMBERED_NODES) do
if PARENTS_OF_NUMBERED_NODES[i] = nodeName then
begin
found := true;
break;
end;
if found then
begin
subnode := ANode.FirstChild;
numItems := 0;
while subnode <> nil do begin
nodeName := subnode.NodeName;
nextSubNode := subNode.NextSibling;
// 1-based numbered nodes
if (nodeName = 'Item') or (nodeName = 'Position') then
begin
inc(numItems);
RenameNode(subnode, nodeName + IntToStr(numItems));
end else
// 0-based numbered nodes
if (nodeName = 'Unit') or (nodeName = 'Mode') or (nodeName = 'List') or
(nodeName = 'Define') then
begin
RenameNode(subnode, nodeName + IntToStr(numItems));
inc(numItems);
end;
subnode := nextSubNode;
end;
if numItems > 0 then
TDOMElement(ANode).SetAttribute('Count', IntToStr(numItems));
end;
FixNode(ANode.FirstChild);
FixNode(ANode.NextSibling);
end;
procedure FixXML(AFileName: string);
var
L: TStrings;
doc: TXMLDocument;
ext: String;
fn: String;
begin
if (pos('*', AFileName) > 0) or (pos('?', AFileName) > 0) then
begin
L := TStringList.Create;
try
FindAllFiles(L, ExtractFileDir(AFileName), ExtractFileName(AfileName), true);
for fn in L do
FixXML(fn);
finally
L.Free;
end;
exit;
end;
ext := Lowercase(ExtractFileExt(AFileName));
if not ((ext = '.lpi') or (ext = '.lpk') or (ext = '.lps')) then
exit;
WriteLn('Processing ', AFilename, '...');
ReadXMLFile(doc, AFileName);
try
FixNode(doc.DocumentElement);
fn := AFileName + '.bak';
if FileExists(fn) then DeleteFile(fn);
RenameFile(AFileName, fn);
WriteXMLFile(doc, AFileName);
finally
doc.Free;
end;
end;
procedure WriteHelp;
begin
WriteLn('fixlp <filename1>[, <filename2> [...]]');
WriteLn(' Wildcards allowed in file names.');
end;
var
i: Integer;
begin
if ParamCount = 0 then
begin
WriteHelp;
Halt;
end;
for i := 1 to ParamCount do
FixXML(ParamStr(i));
end.