From 4109836a16cc706a30319e8df2317516bd7a3c6e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 14 Aug 2020 14:32:10 +0000 Subject: [PATCH] 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 --- applications/fixlp/README.txt | 24 +++++ applications/fixlp/fixlp.lpi | 69 +++++++++++++++ applications/fixlp/fixlp.lpr | 162 ++++++++++++++++++++++++++++++++++ 3 files changed, 255 insertions(+) create mode 100644 applications/fixlp/README.txt create mode 100644 applications/fixlp/fixlp.lpi create mode 100644 applications/fixlp/fixlp.lpr diff --git a/applications/fixlp/README.txt b/applications/fixlp/README.txt new file mode 100644 index 000000000..8dae768f8 --- /dev/null +++ b/applications/fixlp/README.txt @@ -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 [, [, ...]] + + are the names of the Lazarus .lpi, .lps or .lpk files +(with absolute or relative path) to be converted. + +Wildcards are allowed. \ No newline at end of file diff --git a/applications/fixlp/fixlp.lpi b/applications/fixlp/fixlp.lpi new file mode 100644 index 000000000..96b55436e --- /dev/null +++ b/applications/fixlp/fixlp.lpi @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + <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> diff --git a/applications/fixlp/fixlp.lpr b/applications/fixlp/fixlp.lpr new file mode 100644 index 000000000..f603a4e10 --- /dev/null +++ b/applications/fixlp/fixlp.lpr @@ -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. +