unit uDbTree;

interface
// (C) ALphasoft Pty Ltd

uses
	Classes, Generics.Collections, uGlobalDefs, uHashTable;

//  define GLOBAL if using Global.Log etc

const
	RootNodeName     = '_Root_';

type
	asDbPath = string;		// typically '|Arrivals|QF123-864|Flight|QF123|'
    asDbNode = string;		// typically 'Arrivals'
    asDbStub = string;		// typically 'Arrivals|QF123-864|'

	apNode = ^ aNode;
    aNode = record          // a tree node
        ID      : word;     // copied out from root   Global.Data ID=1
        NodeName : string;
        Content : string;
		SubNodes : TList;   // of apNode
        Back    : apNode;   // back path
        Modified : int;     // Seconds at last change
        Table : cHashTable<apNode>;   // nil or subtag table
        AutoInc : int;      // 0 if not used
        UsrObj : TObject;	// user data
        end;


type
	poOnNextNode = procedure ( pt : apNode; depth : integer ) of object;
	aScanTagType = ( ttProlog, ttTag, ttTagEnd, ttComment, ttContent );
    aScanProc = reference to procedure( pn : apNode; depth : int );

	cDbTree = class
		public
			mEr : int;
			mNodeCount : integer;       // stats
			mEditCount : integer;
			mNewOpNodeCount : integer;
			//mCur : apNode;

			constructor  Create( treeID : word = 0; isKey : boolean = false; log : aLogProc = nil );  // 1 for global.data to do statistics
			procedure  Clear;
            destructor Destroy;    override;
			// procedure  Free;
			// procedure  InitXmlDB;
			function   GetRoot : apNode;   inline;
			function   ReadNode( pt : apNode; var name : string; var content : string  ) : integer;
			function   ReadSub( pt : apNode; n : integer; var name : string; var content : string ) : apNode;
			function   FindNodeMulti( pt : apNode; const tn : string ) : apNode;  // multi level search from pt/nil to NodeName tn
            function   Search( pt : apNode; name, cont : string; index : int = 1 ) : apNode;  // multi search for matching(s)

			function   Scan( path : TStringList;  NextNode : poOnNextNode ) : boolean;  overload;
			function   Scan( pt : apNode;  NextNode : poOnNextNode ) : boolean;   overload;
			function   Scan( pt : apNode;  proc : aScanProc ) : boolean;   overload;
			procedure  Sort( pt : apNode; pathl : TStringList );
			//function   CollectList( pt : apNode ) : TStringList;
			function   NewNode( const nam : string; key : boolean; parent : apNode; AutoInc : int = 0 ) : apNode;  overload;// and add to tree
			function   NewNode( const name, attribs : string; parent : apNode ) : apNode;  overload;
			function   CopyNode( const ps, pd : apNode ) : apNode;
            function   Rename( pt : apNode; const name : string ) : boolean;
			function   SetFlag( pn : apNode; const flag : string; state : boolean ) : apNode;
            function   SetNode( pn : apNode; var nodeName : string;  const val : string ) : apNode;
			procedure  DeleteAllFast( pt : apNode; base : boolean = true );
			function   FollowPath_( pathl : TStringList; pt : apNode = nil ) : apNode;  overload;   deprecated; // use fn
			function   FollowPath_( path : string; pt : apNode = nil ) : apNode;  overload;  deprecated; // use fn
			function   GetNode( const path : string ) : apNode;    overload;
            function   GetNode( addr : TList<integer> ) : apNode; overload;
			function   ListNames( const path : string; pt : apNode = nil ) : TStringList;  // returns a TSlist from sub node names
    		procedure  MoveSubs( ps, pd : apNode );
			procedure  CopySubs( const ps : apNode; pd : apNode = nil );
            procedure  CopyBranch( const ps : apNode; pd : apNode = nil );
			//function   OpenNode( path : string; pt : apNode = nil ) : apNode;   use followpath
            function	HasContent( const path : string; out value : string ) : boolean;

			function   AddToList( pt : apNode; const Name, SubName, SubCont : string; unique : boolean = false ) : apNode;
			procedure  DelFromList( pt : apNode; const Name, SubName, SubCont : string );

			function   ForcePath( pathl : TStringList ) : apNode;   overload;
			function   ForcePath( path : asDbPath ) : apNode;   overload;

		protected
            // mState : ( tsNone, tsLoading, tsNew );
			mLog : aLogProc;  // readonly
			mRootNode : aNode; // root of the xml tree
			procedure  LogEr( er : int; const s : string );
			function   CanAdd( const nam : string; parent : apNode ) : boolean;
			function   AddNode( pNode, parent : apNode ) : boolean;
			procedure  DisposeNode( pt : apNode ); // and unlink - searches list
			procedure  DisposeNodeFast( pt : apNode ); // without unlink
			procedure  MoveBranch( pt : apNode );
			function   ForceEditPath( pathl : TStringList ) : apNode;
		private
			mUseCount	: int;
			procedure  IncAutoInc( parent : apNode );
			function   AutoIncName( parent : apNode; const nam : string ) : string;
			//procedure  AutoIncName( pt : apNode );
			procedure  LinkNode( pt, parent : apNode );
			procedure  DoScan( pt : apNode; depth : integer;  NextNode : poOnNextNode );
		end;

	function	FindName( pt : apNode; nam : string ) : apNode;  // single level search ( with hash table )
    function	Back( pt : apNode; n : int ) : apNode;
	function	NodeContent( pt : apNode ) : string;  inline;
	function	NodeName( pt : apNode ) : string;     inline;
    procedure	SetContent( pt : apNode; val : string );
    function	NodeIndex( pt : apNode ) : int;
	function	SubNodeCount( pt : apNode ) : int;   overload;   inline;
	function	SubNode( pt : apNode; n : int ) : apNode;    // n is 0 .. count -1
	function	ReadContent( pt : apNode; const name : string ) : string;
	function	PathCoincides( p1, p2 : TStringList ) : boolean;  // is a change to p1 relevant to p2
    function	PathToStr( path : TStringList ) : string;
    function	StrToPath( path : string ) : TStringList;
	function	ParseList( const path : string ) : TStringList;   deprecated;  // see StrToPath  or buildparamL
	function	IDValue( n : string ) : int;   // get ID decimal value from end of string
	function	SplitOffAttributes( var nam : string ) : string;
    function	ResolvePath( pt : apNode ) : TStringList;
    function	ResolvePathStr( pt : apNode ) : string;
	function	FollowPath( pathl : TStringList; pt : apNode; back : integer = 0 ) : apNode;  overload;
    function	FollowPath( path : string; pt : apNode ) : apNode;  overload;
    function	GetNodeNumerically( addr : TList<integer>; base : apNode ) : apNode;
	function	SubNodeCount( addr : TList<integer>; base : apNode ) : int;   overload;
	//function	PathDifference( pRef, path : TStringList; out back : int ) : TStringList;  // from reference to path
    function	TrimPathToBase( base : asDbNode; var path : TStringList ) : boolean;
    function	PathDif( fromPath, toPath : TStringList; var stepBack : int ) : TStringList;
	function	Traverse( start : apNode; backStep : int; path : TStringList; backAdjust : int = 0 ) : apNode;
    function	EachSubNode( const ps : apNode; var x : int; out ps1 : apNode ) : boolean;  // subnode enumerator  start x := -1
    function	LoadContentList( const pcl : apNode ) : TStringList;  // creates a list caller must free


implementation

uses
	uUtils, uPoller, Windows, ASCII, Dialogs, SysUtils, StrUtils;

const
	MaxAutoInc = 999999;

var  SortPath : TStringList;   // temp parameter for sort list

// _____________________________ utilities _____________________________________


function   NodeContent( pt : apNode ) : string;

	begin
	result := '';
	if pt <> nil then  result := pt.Content;
	end;


function   NodeName( pt : apNode ) : string;

	begin
	result := '';
	if pt <> nil then  result := pt.NodeName;
	end;


procedure	SetContent( pt : apNode; val : string );

	begin
    if ( pt <> nil ) and ( pt.Back <> nil ) then  pt.Content := val;
    end;


function	NodeIndex( pt : apNode ) : int;

	begin
    result := -1;
    if ( pt <> nil ) and ( pt.Back <> nil ) then  begin
        result := pt.Back.SubNodes.IndexOf( pt );
    	end;
    end;


function   SubNodeCount( pt : apNode ) : int;

	begin
	result := 0;
	if ( pt <> nil ) and ( pt.SubNodes <> nil ) then  result := pt.SubNodes.Count;
	end;


function   SubNode( pt : apNode; n : int ) : apNode;

	begin
	result := nil;
	if ( pt <> nil ) and ( pt.SubNodes <> nil ) and ( n < pt.SubNodes.Count ) then  begin
		result := pt.SubNodes[ n ];
		end;
	end;


function  FindName( pt : apNode; nam : string ) : apNode;

	var                  // searches pt subtags for nam - only single level search
		ps : apNode;
		x, i : integer;
	begin
	result := nil;
	if ( pt <> nil ) and ( pt.SubNodes <> nil ) and ( nam <> '' ) then  begin
		if nam[ 1 ] = SubNodeBracket then  begin  // [n]
			x := 2;
			i := GetInt( nam, x );
			if ( i >= 0 ) and ( i < pt.SubNodes.Count ) and
            	( nam[ x ] = SubNodeEndBracket ) then  begin
				result := pt.SubNodes[ i ];      // step in
				end
			else result := nil;
			end
		else if pt.Table <> nil then  begin
			result := pt.Table.Find( nam );
			end
		else  begin
			if pt.SubNodes <> nil then  begin
				for x := 0 to pt.SubNodes.Count - 1 do  begin
					ps := pt.SubNodes[ x ];
					if ps.NodeName = nam then  begin
						result := ps;
						break;
						end;
					end;
                end;
            end;
	    end;
	end;


function   Back( pt : apNode; n : int ) : apNode;

    begin
    result := pt;
    if result <> nil then  begin
        while n > 0 do  begin
            result := result.Back;
            if result = nil then  break;
            Dec( n );
            end;
	    end;
    end;


function   ReadContent( pt : apNode; const name : string ) : string;

	begin
	result := '';
	pt := FindName( pt, name );
	if pt <> nil then  result := pt.Content;
	end;


function   SplitOffAttributes( var nam : string ) : string;

	var
		x : integer;
	begin
	Result := '';
	x := 1;
	while x <= Length( nam ) do  begin
		if nam[ x ] <= ' ' then  begin
			Result := RightStr( nam, Length( nam ) - x );
			nam := LeftStr( nam, x - 1 );
			Trim( Result );
			break;
			end;
		Inc( x );
		end;
	end;


function CreateHashTable() : cHashTable<apNode>;

	begin
	result := cHashTable<apNode>.Create(
		function( pt : apNode ) : string  begin  result := pt.NodeName;  end,  // name match
		procedure( var pt : apNode )  begin  pt := nil;  end,                  // clear slot
		function( pt : apNode ) : boolean  begin  result := pt = nil;  end );  // test for clear
	end;


constructor  cDbTree.Create( treeID : word = 0; isKey : boolean = false; log : aLogProc = nil );

	begin
	mUseCount := 1;
	mLog := log;
	mRootNode.NodeName := RootNodeName;
    mRootNode.ID := treeID;    // debug and stats use
    if isKey then  begin
		mRootNode.Table := CreateHashTable;
    	end;
	end;


procedure  cDbTree.LogEr( er : int; const s : string );

	begin
	if er > mEr then  mEr := er;
	if Assigned( mLog ) then  mLog( er, s );
	end;


procedure  cDbTree.DisposeNodeFast( pt : apNode );

	begin            // does not unlink - ie ignores .Back - must unlink externally
	if pt.ID = 1 then  Dec( mNodeCount );
	if pt.SubNodes <> nil then  pt.SubNodes.Free;
    if pt.Table <> nil then  pt.Table.Free;
	Dispose( pt );  //  FreeMem( pt );  need dispose to free strings
	end;


procedure  Unlink( pt : apNode );

	var
		ppt : apNode;
	begin
	if pt <> nil then  begin
		ppt := pt.Back;
		if ppt <> nil then  begin
			if ppt.SubNodes <> nil then ppt.SubNodes.Delete( ppt.SubNodes.IndexOf( pt ) );   // unlink
			if ppt.Table <> nil then   ppt.Table.Delete( pt );
			end;
        pt.Back := nil;
		end;
	end;


procedure  cDbTree.DisposeNode( pt : apNode ); // and unlink

	begin
	Unlink( pt );
	DisposeNodeFast( pt );
	end;


function   IDValue( n : string ) : int;

    var
    	x, val : int;
	begin
    result := 0;    val := 1;
    x := Length( n );
    while x > 0 do  begin
    	if not IsDecimal( n[ x ] ) then  break;
        result := result + ( ( Ord( n[ x ] ) - Ord( '0' ) ) * val );
        Dec( x );    val := val * 10;
	    end;
    end;


procedure  cDbTree.IncAutoInc( parent : apNode );

	begin
    if ( parent <> nil ) and ( parent.AutoInc <> 0 ) then  begin
    	Inc( parent.AutoInc );
        if parent.AutoInc > MaxAutoInc then  begin
        	parent.AutoInc := 1;
            if mEr < stAutoIncWrapAround then  begin
            	LogEr( stAutoIncWrapAround, 'Wraparound on ' + parent.NodeName );
	            end;
            end;
        end;
    end;


{procedure  cDbTree.AutoIncName( pt : apNode );

	begin
    if pt.Back.AutoInc > 0 then  begin
        if not IsDecimal( pt.NodeName[ Length( pt.NodeName ) ] ) then  begin  // if not already numbered
            pt.NodeName := pt.NodeName + IntToStr( pt.Back.AutoInc );
            IncAutoInc( pt );
            end;
	    end;
    end;}


function  cDbTree.AutoIncName( parent : apNode; const nam : string ) : string;

    var
        n : int;
	begin
    result := nam;
    if parent.AutoInc > 0 then  begin
        if not IsDecimal( nam[ Length( nam ) ] ) then  begin  // if not already numbered
            result := nam + IntToStr( parent.AutoInc );
            n := 0;
            repeat   // step until we find an empty one
                if FindName( parent, result ) = nil then  break;
                IncAutoInc( parent );
                result := nam + IntToStr( parent.AutoInc );
                Inc( n );
            	until n > 1000;
            end;
	    end;
    end;


function   cDbTree.CanAdd( const nam : string; parent : apNode ) : boolean;

    begin
    result := false;
    if ( parent <> nil ) then  begin
        result := true;
        if parent.Table <> nil then  begin
            if FindName( parent, nam ) <> nil then  begin   // collides
                result := false;
                if mEr < erNonUniqueNewKeyNode then  begin
                    LogEr( erNonUniqueNewKeyNode, 'Non Unique NewNode( ' + nam + ' ) on a Key tag' );
                    end;
                end
            end;
	    end;
    end;


procedure  cDbTree.LinkNode( pt, parent : apNode );

	begin
    pt.Back := parent;
    pt.ID := parent.ID;    // set all tags in tree to same ID
    if parent.SubNodes = nil then  parent.SubNodes := TList.Create; // forward link
    parent.SubNodes.Add( pt );
    if parent.Table <> nil then  parent.Table.Add( pt );
    Inc( mNodeCount );  // if pt.ID = 1 then    // wrong for AddNode
    pt.Modified := Seconds;
    end;


function   cDbTree.NewNode( const nam : string; key : boolean; parent : apNode; AutoInc : int = 0 ) : apNode; // and add to list

	var
		pNode : apNode;
        name : string;
	begin
    if parent = nil then  parent := GetRoot;
    name := AutoIncName( parent, nam );
	result := nil;
    if CanAdd( name, parent ) then  begin
        New( pNode );
        pNode.NodeName := name;
        if name <> nam then  IncAutoInc( parent );

        if key then  pNode.Table := CreateHashTable
        else  		 pNode.Table := nil;
        pNode.AutoInc := AutoInc;
        pNode.SubNodes := nil;
        pNode.UsrObj := nil;
        LinkNode( pNode, parent );
        result := pNode;
        end;
	end;


function   cDbTree.NewNode( const name, attribs : string; parent : apNode ) : apNode;

	var
        p, auto : int;
	begin
    p := Pos( Attrib_AutoInc, attribs );    auto := 0;
    if p > 0 then  begin
        p := p + Length( Attrib_AutoInc );
        auto := GetInt( attribs, p );
        end;
    result := NewNode( name, Pos( Attrib_Key, attribs ) > 0, parent, auto );
    end;


function   cDbTree.CopyNode( const ps, pd : apNode ) : apNode;

	begin
    result := NewNode( ps.NodeName, ps.Table <> nil, pd, ps.AutoInc );
    result.Content := ps.Content;
    end;


function   cDbTree.Rename( pt : apNode; const name : string ) : boolean;

    var
        pParent : apNode;
	begin
    result := false;
    pParent := pt.Back;
    if ( pParent <> nil ) and ( CanAdd( name, pParent ) ) then  begin
    	if pParent.Table <> nil then   pParent.Table.Delete( pt );
        pt.NodeName := name;
        if pParent.Table <> nil then   pParent.Table.Add( pt );
        result := true;
    	end;
    end;


procedure  cDbTree.MoveSubs( ps, pd : apNode );

	var
		pt : apNode;
		doit : bool;
	begin
	if ( ps <> nil ) and ( ps.SubNodes <> nil ) and ( pd <> nil ) then  begin
        for pt in ps.SubNodes do  begin
            doit := true;
            if Assigned( pd.Table ) then  begin   // already on a key tag ?
                if FindName( pd, pt.NodeName ) <> nil then  doit := false;
                end;
            if doit then  begin
                Unlink( pt );
                AddNode( pt, pd );
                end;
	        end;
		end;
	end;


procedure  cDbTree.CopySubs( const ps : apNode; pd : apNode = nil );

	var
		ps1 : apNode;
        x : int;
	begin
    if pd = nil then  pd := GetRoot;

	if ( ps <> nil ) and ( pd <> nil ) then  begin
        x := -1;
        while EachSubNode( ps, x, ps1 ) do  CopyBranch( ps1, pd );
		end;
    end;


procedure  cDbTree.CopyBranch( const ps : apNode; pd : apNode = nil );

	var
		pd1 : apNode;
	begin
    if pd = nil then  pd := GetRoot;

	if ( ps <> nil ) and ( pd <> nil ) then  begin
        pd1 := CopyNode( ps, pd );
        CopySubs( ps, pd1 );
		end;
    end;


function	cDbTree.HasContent( const path : string; out value : string ) : boolean;

	var
    	pt : apNode;
	begin
    result := false;
    pt := FollowPath( path, @ mRootNode );
    if pt <> nil then  begin
    	value := pt.Content;
        result := true;
    	end;
    end;


function   cDbTree.SetNode( pn : apNode; var nodeName : string;  const val : string ) : apNode;

    var
    	pt : apNode;
	begin
    if pn = nil then  pn := GetRoot;
    pt := FindName( pn, nodeName );
    if pt = nil then  begin  //  need to create one
        pt := NewNode( nodeName, '', pn );
        nodeName := pt.NodeName;  // could be a numbered auto inc
    	end;
    if pt <> nil then  pt.Content := val;
    result := pt;
    end;


function   cDbTree.SetFlag( pn : apNode; const flag : string; state : boolean ) : apNode;

	begin             // new or delete subnode acording to state
    result := nil;
    if pn <> nil then  begin
        result := FindName( pn, flag );
        if state then  begin
        	if result = nil then  result := NewNode( flag, false, pn );
	        end
        else  if result <> nil  then  begin
            DeleteAllFast( result );
            result := nil;
	        end;
    	end;
    end;


function   cDbTree.AddNode( pNode, parent : apNode ) : boolean;

	begin
	result := false;
    if CanAdd( pNode.NodeName, parent ) then  begin
        LinkNode( pNode, parent );
		Result := true;
		end;
	end;


procedure  cDbTree.MoveBranch( pt : apNode );

	var
		pr : apNode;
		doit : bool;
	begin
	if pt <> nil then  begin
		doit := true;
		pr := GetRoot;
		if Assigned( pr.Table ) then  begin
			if FindName( pr, pt.NodeName ) <> nil then  doit := false;
			end;
		if doit then  begin
			Unlink( pt );
			AddNode( pt, pr );
			end;
		end;
	end;


procedure  cDbTree.DeleteAllFast( pt : apNode; base : boolean = true );

	var
		pd : apNode;
		x  : integer;
	begin        // only unlinks the base tag
	if ( pt <> nil ) and ( pt.SubNodes <> nil ) then  begin
		for x := pt.SubNodes.Count - 1 downto 0 do  begin
			pd := pt.SubNodes[ x ];
			DeleteAllFast( pd, false );
			end;
		// if pt.SubNodes <> nil then  pt.SubNodes.Free;
		// if pt.Table <> nil then  pt.Table.Free;
		end;
	if pt <> nil then  begin
		if base then  DisposeNode( pt )       // and unlink
		else          DisposeNodeFast( pt );
		end;
	end;


{procedure cDbTree.ClearNode( pNode : apNode );   // dispose of everything upstream

	var
		pt : apNode;  // the sub tags
		x : integer;
	begin
	if pNode <> nil then  begin
		if pNode.SubNodes <> nil then  begin
			for x := 0 to pNode.SubNodes.Count - 1 do  begin
				pt := pNode.SubNodes[ x ];
				if pt.SubNodes <> nil  then  begin
					ClearNode( pt );
					end;
				{$ifndef LEAK }{
				pt.SubNodes.Free;
				Dispose( pt );  // FreeMem( pt );  leaks the strings
				{$endif }{
				end;
			end;
		end;
	end;


procedure  cDbTree.Claim;

	begin
	Inc( mUseCount );
	end;  }


procedure cDbTree.Clear;

	var
		pt : apNode;
	begin
	if mRootNode.SubNodes <> nil then  begin
		for pt in mRootNode.SubNodes do  DeleteAllFast( pt );
		FreeAndNil( mRootNode.SubNodes );
		FreeAndNil( mRootNode.Table );
		end;
	end;


destructor cDbTree.Destroy;

	begin
	if self <> nil then  begin
		Dec( mUseCount );
		if mUseCount = 0 then  begin
			Clear;
			inherited Destroy;
			end;
		end;
	end;


function   cDbTree.GetRoot : apNode;

	begin
	Result := @mRootNode;
	end;


function   cDbTree.GetNode( const path : string ) : apNode;  // overload;

	begin
	if path <> '' then  result := FollowPath( path, GetRoot )
    else  result := nil;
	end;


function	cDbTree.GetNode( addr : TList<integer> ) : apNode;  // overload;

	var
    	x : int;
	begin
    result := GetRoot;
    for x in addr do  begin
        result := SubNode( result, x );
        if result = nil then  break;
    	end;
    end;


function   PathToStr( path : TStringList ) : string;

    var
    	p : int;
	begin
    result := '';
    if path <> nil then  begin
        for p := 0 to path.Count - 1 do  begin
            if p = 0 then  result :=  LSep + path[ 0 ] + LSep
            else  result := result + path[ p ] + LSep;
        	end;
    	end;
    end;


function	StrToPath( path : string ) : TStringList;

	var                  //  |Head|Subhead|  style list
		x : integer;
		tg, p : string;
	begin
	Result := TStringList.Create;
	x := 1;     p := path;
    if p = '' then  p := LSep;
    while x <= Length( p ) do  begin  // skip initial whitespace and LSep
        if p[ x ] = LSep then  begin  Inc( x );  break;  end
        else if p[ x ] > ' ' then  break;
        Inc( x );
        end;

    while x <= Length( p ) do  begin   // build list
        if p[ x ] = LSep then  begin
            Result.Add( tg );
            tg := '';
            end
        else tg := tg + p[ x ];
        Inc( x );
        end;
    if tg <> '' then  Result.Add( tg );   // in case there is no trailing LSep
   	end;


function   ParseList( const path : string ) : TStringList;

	begin
    result := StrToPath( path );
    end;


(*
function   cDbTree.ResolvePath( pt : apNode ) : TStringList;   // makes a path list to pt

	var
		sl : TStringList;
		n : string;
		ppt : apNode;   // p parent tag
		pct : apNode;   // p contending match tag
		x, c : integer;
	begin
	sl := TStringList.Create;
	while pt.Back <> nil do  begin
		n := pt.NodeName;
		sl.Insert( 0, n );
		ppt := pt.Back;   // step back
		c := 1;           // count matching names to make a path#N entry
		for x := 0 to ppt.SubNodes.Count - 1 do begin
			if pt = ppt.SubNodes[ x ] then  break
			else begin
				pct := ppt.SubNodes[ x ];
				if n = pct.NodeName then  Inc( c );
				end;
			end;
		if c <> 1 then  begin
			n := n + '#' + IntToStr( c );   // todo deprecated
			sl[ 0 ] := n;
			end;
		pt := ppt;  // move to parent tag
		end;
	Result := sl;
	end;   *)


function   ResolvePath( pt : apNode ) : TStringList;   // makes a path list to pt

	var
		sl : TStringList;
	begin
	sl := TStringList.Create;
    if pt <> nil then  begin
        while pt.Back <> nil do  begin
            sl.Insert( 0, pt.NodeName );
            pt := pt.Back;   // step back
            end;
	    end;
	Result := sl;
	end;


function   ResolvePathStr( pt : apNode ) : string;   // breaking change 28 apr 2011 - '|asdf|asdf|' form  was 'adsf|adf|adfs'

	var
		pl : TStringList;
		t : int;
	begin
	result := '';
	if pt <> nil then  begin
    	result := LSep;
		pl := ResolvePath( pt );
		for t := 0 to pl.Count - 1 do  begin
			result := result + pl[ t ] + LSep;
			end;
		pl.Free;
		end;
    end;


//function   ResolvePathStr( pt : apNode ) : string;     was  breaking change 28 apr 2011 -
//
//	var
//		pl : TStringList;
//		t : int;
//	begin
//	result := '';
//	if pt <> nil then  begin
//		pl := ResolvePath( pt );
//		for t := 0 to pl.Count - 1 do  begin
//			result := result + pl[ t ];
//            if t < pl.Count - 1 then  result := result + LSep;
//			end;
//		pl.Free;
//		end;
//    end;


function  FollowPath( pathl : TStringList; pt : apNode; back : integer = 0 ) : apNode;

	var              // Follows the pathl list from pt
		n : integer;
	begin
	result := nil;
	if pathl <> nil then  begin
		result := pt;    n := 0;
		while ( n < pathl.Count - back ) and ( result <> nil )  do  begin
			result := FindName( result, Pathl[ n ] );    // step in
			Inc( n )    // next tag depth
			end;
		end;
	end;


function   FollowPath( path : string; pt : apNode ) : apNode;//  overload;

	var
		pl : TStringList;
	begin
	pl := StrToPath( path );
	Result := FollowPath( pl, pt );
	pl.Free;
	end;



function	GetNodeNumerically( addr : TList<integer>; base : apNode ) : apNode;

    var
    	n : int;
	begin
    result := base;
    for n in addr do  result := SubNode( result, n );
    end;


function	SubNodeCount( addr : TList<integer>; base : apNode ) : int;

	begin
    result := uDbTree.SubNodeCount( GetNodeNumerically( addr, base ) );
    end;



//function	PathDifference( pRef, path : TStringList; out back : int ) : TStringList;  // from reference to path
//
//	var
//    	x : int;
//	begin
//	x := 0;  back := 0;
//    result := TStringList.Create;
//    while true do  begin
//        if ( x >= pRef.Count ) then  break;
//        if ( x >= path.Count ) then  break;
//    	if pRef[ x ] <> path[ x ] then  break;
//        Inc( x );
//    	end;
//
//    if pRef.Count - 1 > x then  back := pRef.Count - x;
//    while x < path.Count do  begin
//        result.Add( path[ x ] );
//        Inc( x );
//        end;
//    end;



function	TrimPathToBase( base : asDbNode; var path : TStringList ) : boolean;

	begin
    result := false;
    while ( path.Count > 0 ) and ( base <> path[ 0 ] ) do  begin
        path.Delete( 0 );
    	end;
    if ( path.Count > 0 ) and ( base = path[ 0 ] ) then  begin   // got a match
        path.Delete( 0 );
        result := true;
    	end;
    end;


function	PathDif( fromPath, toPath : TStringList; var stepBack : int ) : TStringList;

                  // how should the chicken cross the road ?  back a few then up these steps - see Traverse below
	var           // assumes paths trimmed to a common base eg 'Timetable' and toPath may be flattened eg '[0]' from DS
    	x, highestMatch : int;
	begin
	x := 0;  stepBack := 0;   highestMatch := -1;
    result := TStringList.Create;
    if ( toPath <> nil ) and ( fromPath <> nil ) then  begin
        while true do  begin
            if x >= fromPath.Count then  break;
            if x >= toPath.Count then  break;
            if fromPath[ x ] = toPath[ x ] then  highestMatch := x;
            if toPath[ x ] = '[0]' then  highestMatch := x;
            Inc( x );
            end;

        stepBack := fromPath.Count - highestMatch - 1;
        x := highestMatch + 1;
        while x < toPath.Count do  begin
            result.Add( toPath[ x ] );
            Inc( x );
            end;
    	end;
    end;


function	Traverse( start : apNode; backStep : int; path : TStringList; backAdjust : int = 0 ) : apNode;

	begin            // handles up and down hill paths
    result := nil;
    if ( start <> nil ) and ( path <> nil ) then  begin
        if path.Count <= backAdjust then  result := Back( start, backStep + backAdjust - path.Count )
        else  begin
            result := Back( start, backStep );
            result := FollowPath( path, result, backAdjust );
            end;
    	end;
    end;


function   EachSubNode( const ps : apNode; var x : int; out ps1 : apNode ) : boolean;

	begin
    result := false;
    Inc( x );
    if ( ps <> nil ) and ( ps.SubNodes <> nil ) and ( x < ps.SubNodes.Count ) then  begin
    	ps1 := ps.SubNodes[ x ];
        result := true;
	    end;
    end;


function   LoadContentList( const pcl : apNode ) : TStringList;  // creates a list caller must free

    var
    	i : int;
	begin
    result := nil;
    if ( pcl <> nil ) and ( pcl.Content <> '' ) then  begin
		i := 1;  result := BuildParamsL( pcl.Content, i );
	    end;
    end;


function   PathCoincides( p1, p2 : TStringList ) : boolean;  // is a change to p1 relevant to p2

	var
		n : int;
	begin
	Result := true;
	if ( p1 <> nil ) and ( p2 <> nil ) then  begin
		n := 0;
		repeat
			if n >= p1.Count then  break;  // change here affects p2
			if n >= p2.Count then  break;
			if p1[ n ] <> p2[ n ] then  begin  // paths have diverged
				Result := false;
				break;
				end;
			Inc( n );
			until false;
		end
	else  Result := false;
	end;


function   cDbTree.ReadSub( pt : apNode; n : integer; var name : string; var content : string ) : apNode;

	begin
	if pt = nil then  pt := @mRootNode;
	if ( pt.SubNodes <> nil ) and ( pt.SubNodes.Count >= n ) then  begin
		pt := pt.SubNodes[ n ];
		name := pt.NodeName;
		content := pt.Content;
		end;
	Result := pt;
	end;


function   cDbTree.ReadNode( pt : apNode; var name : string; var content : string  ) : integer;

	begin
	Result := 0;
	if pt = nil then  pt := @mRootNode;
	name := pt.NodeName;
	content := pt.Content;
	if pt.SubNodes <> nil  then  Result := pt.SubNodes.Count;
	end;


{function   cDbTree.OpenNode( path : string; pt : apNode = nil ) : apNode;

	var
		pl : TStringList;
	begin
	pl := ParseList( path );
	Result := FollowPath( pl, pt );
	pl.Free;
	end; }


function   FindSubNode( pt : apNode; const tn : string ) : apNode;  // multi level search from pt to NodeName tn

	var
		pn : apNode;
		x : integer;
	begin
	result := nil;
	if ( pt <> nil ) and ( pt.SubNodes <> nil ) then  begin
		for x := 0 to pt.SubNodes.Count - 1 do  begin
			pn := pt.SubNodes[ x ];
			result := FindName( pn, tn );
			if result <> nil then  break;
			result := FindSubNode( pn, tn );
			if result <> nil then  break;
			end;
		end;
	end;


function   cDbTree.FindNodeMulti( pt : apNode; const tn : string ) : apNode;

	begin
	if pt = nil then  pt := @mRootNode;
    if pt.NodeName = tn then  result := pt
    else  begin
        result := FindName( pt, tn );
        if result = nil then  result := FindSubNode( pt, tn );
    	end;
	end;


function   cDbTree.ListNames( const path : string; pt : apNode = nil ) : TStringList;

	var                           // returns a TSlist from sub node names
		n : int;
		pn : apNode;
	begin
	result := nil;
	if pt = nil then  pt := @mRootNode;
	pt := FollowPath( path, pt );
	if pt <> nil then  begin
		result := TStringList.Create;
		if pt.SubNodes <> nil then  begin
			for n := 0 to pt.SubNodes.Count - 1 do  begin
				pn := pt.SubNodes[ n ];
				result.Add( pn.NodeName );
				end;
			end;
		end;
	end;


function   cDbTree.AddToList( pt : apNode; const Name, SubName, SubCont : string; unique : boolean = false ) : apNode;

    var
        pf, pn : apNode;
        i : int;
        rep : boolean;
	begin
    rep := false;    result := nil;
    if pt <> nil then  begin
        pf := FindName( pt, Name );     // create list header if necessary
        if pf = nil then  pf := NewNode( Name, false, pt );  // not key - multiple <file> s
        if unique then  begin
            if ( pf <> nil ) and ( pf.SubNodes <> nil ) then  begin
                for i := 0 to pf.SubNodes.Count - 1 do  begin
                    pn := pf.SubNodes[ i ];
                    if pn.NodeName = SubName then  begin
                        if pn.Content = SubCont then  begin  // not unique
                            rep := true;
                            break;
                            end;
                        end;
                    end;
                end;
        	end;

        if not rep and ( pf <> nil )  then  begin
            result := NewNode( SubName, false, pf );
            result.Content := SubCont;
            end;
        end;
    end;
//		<z.files>
//			<file> C:\PHOTO\JPG 1990s\1996\96 APR MT rats zoo\1996 APR 08.jpg </file>
//			<file> C:\PHOTO\JPG 1990s\1996\96 APR MT rats zoo\1996 APR 05.jpg </file>
//			<file> C:\PHOTO\JPG 1990s\1996\96 APR MT rats zoo\1996 APR 10.jpg </file>


procedure  cDbTree.DelFromList( pt : apNode; const Name, SubName, SubCont : string );

    var
        pf, pn : apNode;
        i : int;
	begin
    if pt <> nil then  begin
        pf := FindName( pt, Name );     // find list header
        if ( pf <> nil ) and ( pf.SubNodes <> nil ) then  begin
        	for i := 0 to pf.SubNodes.Count - 1 do  begin  // search for correct item
            	pn := pf.SubNodes[ i ];
                if ( pn.NodeName = SubName ) and ( pn.Content = SubCont ) then  begin
                    DeleteAllFast( pn );
                    break;
                    end;
                end;
        	end;
        end;
    end;


function  cDbTree.FollowPath_( pathl : TStringList; pt : apNode = nil ) : apNode;

	var              // Follows the pathl list from root
		n : integer;
		nam : string;
	begin
	n := 0;
	result := nil;
	if pathl <> nil then  begin
	if pt = nil then  result := @mRootNode  else  result := pt;
		while n < pathl.Count do  begin
			// Result := nil;
			nam := Pathl[ n ];
			if nam <> '' then  result := FindName( result, nam )    // step in
			else               result := nil;

			if result <> nil then  Inc( n )    // next tag depth
			else  break;  // doesn't exist
			end;
		end;
	end;


function   cDbTree.FollowPath_( path : string; pt : apNode = nil ) : apNode;//  overload;

	var
		pl : TStringList;
	begin
	pl := StrToPath( path );
	Result := FollowPath( pl, pt );
	pl.Free;
	end;


function  cDbTree.ForcePath( pathl : TStringList ) : apNode;  //overload;

	var                      // follows or creates pathl list
		pt, pn : apNode;
		n : integer;
		nam, atrib : string;
	begin
	n := 0;
	pt := @mRootNode;
	while n < pathl.Count do  begin
        nam := pathl[ n ];
        atrib := SplitOffAttributes( nam );  // don't try to match attributes
		{if pt.SubNodes = nil  then   begin    // create subnode list as well as new tag
			// SplitPathName( nam );                // remove #
			// pn := NewNode( nam, Pos( Attrib_Key, atrib ) > 0, pt  );
            pn := DoBuildTag( nam, atrib, pt );

			end
		else  begin }
			pn := FindName( pt, nam );
			if pn = nil then  begin            // not found so create one
				//pn := NewNode( nam, Pos( Attrib_Key, atrib ) > 0, pt );
	            pn := NewNode( nam, atrib, pt );
				end;
			//end;
		Inc( n );  pt := pn;
        if pt = nil then  break;
		end;
	Result := pt;
	end;


function   cDbTree.ForcePath( path : asDbPath ) : apNode;   //overload;

	var
    	pathl : TStringList;
	begin
    pathl := StrToList( path );
    result := ForcePath( pathl );
    FreeAndNil( pathl );
    end;


function  cDbTree.ForceEditPath( pathl : TStringList ) : apNode;

	var                      // follows or creates pathl list if not key
		pt, pn : apNode;
		n : integer;
		nam, atrib : string;
	begin
	n := 0;
	if pathl.Count > 0 then  pt := @mRootNode  else  pt := nil;
	while n < pathl.Count do  begin
			nam := pathl[ n ];
			atrib := SplitOffAttributes( nam );  // don't rty to match attributes
			pn := FindName( pt, nam );
			if pn = nil then  begin            // not found so create one
				if pt.Table <> nil then  begin
					pt := nil;
					break;
					end;
				pn := NewNode( nam, atrib, pt );
				end;

{		if pt.SubNodes = nil  then   begin    // create subtag list as well as new tag
			if pt.Table <> nil then  begin
				pt := nil;
				break;
				end;
			nam := pathl[ n ];
			atrib := SplitOffAttributes( nam );  // don't try to match attributes
			//SplitPathName( nam );                // remove #
			pn := NewNode( nam, Pos( Attrib_Key, atrib ) > 0, pt );
			end
		else  begin
			nam := pathl[ n ];
			atrib := SplitOffAttributes( nam );  // don't rty to match attributes
			pn := FindName( pt, nam );
			if pn = nil then  begin            // not found so create one
				if pt.Table <> nil then  begin
					pt := nil;
					break;
					end;
				pn := NewNode( nam, Pos( Attrib_Key, atrib ) > 0, pt );
				end;
			end; }
		Inc( n );  pt := pn;
        if pt = nil then  break;
		end;
	Result := pt;
	end;


procedure  DoScanProc( pt : apNode; depth : integer;  proc : aScanProc );

	var
		x : integer;
	begin
	proc( pt, depth );
	if pt.SubNodes <> nil then  begin
		for x := 0 to pt.SubNodes.Count - 1 do  begin
			DoScanProc( pt.SubNodes[ x ], depth + 1, proc );
			end;
		end;
	end;


function   cDbTree.Scan( pt : apNode;  proc : aScanProc ) : boolean;

	var
		depth : integer;
	begin
	Result := true;
	if pt = nil  then  begin
    	pt := GetRoot();
        result := false;
	    end;
	if pt <> nil then  begin
		depth := 0;
		DoScanProc( pt, depth, proc );
		end;
	end;


procedure  cDbTree.DoScan( pt : apNode; depth : integer;  NextNode : poOnNextNode );

	var
		x : integer;
	begin
	NextNode( pt, depth );
	if pt.SubNodes <> nil then  begin
		for x := 0 to pt.SubNodes.Count - 1 do  begin
			DoScan( pt.SubNodes[ x ], depth + 1, NextNode );
			end;
		end;
	end;


function   cDbTree.Scan( path : TStringList;  NextNode : poOnNextNode ) : boolean;

	var
		pt : apNode;
		depth : integer;
	begin
	Result := true;

	if path <> nil then  pt := FollowPath( path, GetRoot() )
	else                 pt := GetRoot();
	if pt <> nil then  begin
		if path <> nil then  depth := path.Count
		else  depth := 0;
		DoScan( pt, depth, NextNode );
		end
	else  Result := false;
	end;


function   cDbTree.Scan( pt : apNode;  NextNode : poOnNextNode ) : boolean;

	var
		x : integer;
	begin
	Result := true;
    if pt = nil then   pt := GetRoot;
	if pt.SubNodes <> nil then  begin
		for x := 0 to pt.SubNodes.Count - 1 do  begin
			DoScan( pt.SubNodes[ x ], 1, NextNode );
			end;
		end;
	end;


function   DoSearch( pt : apNode; name, cont : string; index : int ) : apNode;

	var
		i : integer;
    begin
    result := nil;
    if (( cont = '' ) or ( cont = pt.Content )) and
       (( name = '' ) or ( name = pt.NodeName )) then  begin
        Dec( index );  if index <= 0 then  result := pt;
    	end;
    if ( result = nil ) and ( pt.SubNodes <> nil ) then  begin
		for i := 0 to pt.SubNodes.Count - 1 do  begin
			result := DoSearch( pt.SubNodes[ i ], name, cont, index );
            if result <> nil then  break;
	        end;
    	end;
    end;


function   cDbTree.Search( pt : apNode; name, cont : string; index : int = 1 ) : apNode;  // multi search for matching(s)

	var
		x : integer;
	begin
	Result := nil;
    if pt = nil then   pt := GetRoot;
	if pt.SubNodes <> nil then  begin
		for x := 0 to pt.SubNodes.Count - 1 do  begin
			result := DoSearch( pt.SubNodes[ x ], name, cont, index );
            if result <> nil then  break;
			end;
		end;
    end;


function   NamedContent( pt : apNode; const nam : string ) : string;

	begin
	pt := FindName( pt, nam );
	if pt = nil then  Result := ''
	else              Result := pt.Content;
	end;


function   CompareNodes( pap, pbp : pointer ): Integer;

    var
    	pa, pb : apNode;
    begin
    result := 0;
    pa := FollowPath( SortPath, pap );
    pb := FollowPath( SortPath, pbp );
    if ( pa <> nil ) and ( pb <> nil ) then  begin
        result := CompareText( pa.Content, pb.Content );
        end;
    end;


procedure  cDbTree.Sort( pt : apNode; pathl : TStringList );

	var                 // pathl is a relative path to the field to sort by
		x, y : int;
		pta, ptb : apNode;
		sl : TList;  // of apNode
		done : boolean;
		nam : string;
	begin
	if pt = nil then  pt := @mRootNode;
	if ( pathl <> nil ) then if pathl.Count > 0 then  begin
		sl := TList.Create;
		if pathl.Count = 1 then  begin  // simpler faster case
			nam := pathl[ 0 ];
			if pt.SubNodes <> nil then for x := 0 to pt.SubNodes.Count - 1 do  begin
				pta := pt.SubNodes[ x ];   done := false;
				for y := 0 to sl.Count - 1 do  begin  // slip it into the right spot  todo index or halve interval
					ptb := sl[ y ];
					if NamedContent( ptb, nam ) > NamedContent( pta, nam ) then  begin  // insert before
						sl.Insert( y, pta );
						done := true;
						break;
						end;
					end;  // for y
				if not done then  sl.Add( pta );
				end;  // for x
            pt.SubNodes.Free;
            pt.SubNodes := sl;  // use sorted list now
			end

		else if pathl.Count > 1 then  begin
            if pt.SubNodes <> nil then  begin
            	SortPath := pathl;
                pt.SubNodes.Sort( CompareNodes );
                SortPath := nil;
            	end;
			end;
		end;
	end;


end.
