You've already forked lazarus-ccr
fixlp: new utility program to convert Lazarus xml files written by v2.1+ to older versions.
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
24
applications/fixlp/README.txt
Normal file
24
applications/fixlp/README.txt
Normal 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
69
applications/fixlp/fixlp.lpi
Normal 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
162
applications/fixlp/fixlp.lpr
Normal 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.
|
||||
|
||||
Reference in New Issue
Block a user