// Reconcile DEP-5 debian/copyright to licensecheck
//
// Copyright : 2025 P Blackman
// License   : BSD-2-clause
//
// Routine to encapsulate array of file data

unit filedata;
{$mode delphi}

interface uses Classes;

procedure GlobSearch (Str : String; out S1 : AnsiString);
Function  SetDep5License   (FileNum, PD, GC : Integer; lic : string) : Boolean;
procedure SetActualLicense (FileNum : Integer; lic : string);
procedure InitFileData (SourceList : tStringList);
procedure UnMangleFileNames;

function FindThisFile (const FileStr : AnsiString) : Integer;
function GetMatch (out FileNum : Integer; Filename : string) : Boolean;
function CheckFiles : Boolean;


implementation uses SysUtils, StrUtils, rstrings, support, exclude,
        gfdl, gpl, gpla, spdx, spdx2, dotzero, eclipse, psf, andor, options;

type
    tFileLic =
    record
        PathDepth,
        GlobCount : Integer;  // Only for checking stanza ordering
        FName     : AnsiString;
        Dep5,
        Actual    : String;  // License short names
    end;
    tFileLicArray = array of tFileLic;

var
    MyFiles : tFileLicArray;


// use * to match anything in a file name string
// Effects a recursive directory match
procedure GlobSearch (Str : String; out S1 : AnsiString);
var P : Integer;
    BStr, EStr : String;
    MyFile : tFileLic;
begin
    S1 := '';
    P    := PosEx ('*', Str);
    Assert (P <> 0, 'Lost the asterisk!');

    BStr := Copy (Str, 1, P-1);
    EStr := Copy (Str, P+1, length(Str) -P);

    for MyFile in MyFiles do
        if  StartsStr (BStr, MyFile.FName)
        and EndsStr   (EStr, MyFile.FName) then
            S1 := S1 + MyFile.FName + LineEnding;
end;

function SetDep5License (FileNum, PD, GC : Integer; lic : string) : Boolean;
begin
    result := true;
    with MyFiles[FileNum] do
        begin
        if (GC > 0) and (Dep5 <> '') and (Dep5 <> lic) then
        begin
            // Later stanzas (for same file) should not have lower path depth
            if (PD < PathDepth) then
                result := false;

            // Later stanzas (for same file) should not have higher glob count,
            // unless path depth is higher
            if (GC > GlobCount) and (PD <= PathDepth) then
                result := false;
        end;

        PathDepth := PD;
        GlobCount := GC;
        Dep5      := lic;
    end;
end;

procedure SetActualLicense (FileNum : Integer; lic : string);
begin
    MyFiles[FileNum].Actual := lic;
end;

procedure InitFileData (SourceList : tStringList);
var C, Posn : Integer;
    Line    : AnsiString;
begin
    SetLength (MyFiles, SourceList.Count);
    for C := 0 to SourceList.Count -1 do
    begin
        Posn             := 3; // Strip leading ./
        Line             := SourceList.Strings[C];

        with MyFiles[C] do
        begin
            Fname     := ExtractSubstr (Line, Posn, []);
            Dep5      := '';
            Actual    := '';
            PathDepth := 0;
            GlobCount := 0;
        end;
    end;
end;

procedure UnMangleFileNames;
var FileNum : Integer;
begin
    for FileNum := 0 to High (MyFiles) do
        UnMangleName (MyFiles[FileNum].Fname);
end;

// locate a file from d/copyright, find its index in the source file array
function FindThisFile (const FileStr : AnsiString) : Integer;
var FileNum : Integer;
    Found : Boolean;
begin
    Found := false;
    FileNum := 0;

    while not found and (FileNum < Length (MyFiles)) do
    begin
        if MyFiles [FileNum].FName = FileStr then
            found := true
        else
            inc (FileNum);
    end;

    if not found then
    begin
        writeln ('** ' + rsSfp + ' ', FileStr); // Superfluous file pattern
        FileNum := -1;
    end;

    result := FileNum;
end;

// Search for given file name, and return its index
function GetMatch (out FileNum : Integer; Filename : string) : Boolean;
begin
    FileNum  := 0;
    result := FileName = MyFiles[FileNum].Fname;
    While not result and (FileNum < High (MyFiles)) do
    begin
        inc (FileNum);
        result := FileName = MyFiles[FileNum].Fname;
    end;
end;

// Traverse the file data array,
// looking for mismatch in license strings.
// Output the main body of the report.
function CheckFiles : Boolean;
var MyFile : tFileLic;
    Header,
    GotOne,
    MisMatch,
    FalsePositive : Boolean;
    last_Dep5,
    Last_Actual : String;

begin
    Header      := False;
    GotOne      := False;
    MisMatch    := False;
    Last_Dep5   := '';
    Last_Actual := '';

    for MyFile in MyFiles do
      with MyFile do
        if (Actual <> '') then
        begin
            MisMatch := not SameText(Dep5, Actual);
            FalsePositive := false;

            if MisMatch and not IgnoreFile (Fname) then
                FalsePositive :=
                    // Workarounds for various problems with licensecheck
                       CheckGPL     (Fname, Dep5, Actual)
                    or CheckGPLa    (Fname, Dep5, Actual)
                    or CheckSPDX    (Fname, Dep5, Actual)
                    or CheckSPDX2   (Fname, Dep5, Actual)
                    or CheckGFDL    (Fname, Dep5, Actual)
                    or CheckEclipse (Fname, Dep5, Actual)
                    or CheckPSF2    (Fname, Dep5, Actual)
                    or CheckDotZero (Dep5, Actual)
                    or CheckANDOR   (Dep5, Actual)
                    or CheckAlias   (Dep5, Actual)
                    or ContainsStr (Actual, 'Autoconf-data');

            if not IgnoreFile (Fname) and (Option_Long
            or MisMatch and not FalsePositive) then
            begin
               if not Header and not Option_Format then
                begin
                    Writeln ('d/copyright      | licensecheck');
                    Writeln;
                    Header := True;
                end;

                if Option_Short and (Dep5 = last_Dep5) and (Actual = Last_Actual) then
                    // skip this file
                else
                if Option_Format then
                begin
                    Writeln (Dep5);
                    Writeln (Actual);
                    Writeln (FName);
                    Writeln;
                end
                else
                    Writeln (PadRight(Dep5,17), '| ', PadRight(Actual,17), ' ',FName);

                Last_Dep5   := Dep5;
                Last_Actual := Actual;
                GotOne      := GotOne or (MisMatch and not FalsePositive);
            end;
        end;

    result := GotOne;
end;

end.
