// Parsing of DEP-5 copyright file
//
// Copyright : 2023 P Blackman
// License   : BSD-2-clause
//


type // Field types
    ftype = (fNull, fEOF, fBlank, fFormat, fFiles, fUName, fUContact,
            fSource, fDisclaimer, fComment, fLicense, fCopyRight, fContinue);
var
    cfile : Text;
    crline : ansistring;
    LastField : ftype;


function Test (S : String) : Boolean;
begin
    if Length (crline) < Length (S) then
        result := false
    else
        result := s = ExtractWord (1, crline, WhiteSpace);
end;

function CheckLine : ftype;
begin
    IF EOF (cfile ) then
        result := fEOF
    else
    if Test ('Files:') then
        result := fFiles
    else
    if Test ('License:') then
        result := fLicense
    else
    if Test ('Copyright:') then
        result := fCopyright
    else
    if Test ('copyright:') then
        result := fCopyright
    else
    if Test ('Comment:') then
        result := fComment
    else
    if Test ('Upstream-Name:') then
        result := fUName
    else
    if Test ('Upstream-Contact:') then
        result := fUContact
    else
    if Test ('Source:') then
        result := fSource
    else
    if Test ('Disclaimer:') then
        result := fDisclaimer
    else
    if IsEmptyStr (crline, WhiteSpace) then
        result := fBlank
    else
    if crline[1] in WhiteSpace then
        result := fContinue
    else
        if (crline = 'Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/')
        or (crline = 'Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/') then
            result := fFormat
    else
        result := fNull;

    if not (result in [fBlank, fContinue, fNull, fEOF]) then
        LastField := result;
end;



function FindThisFile (const FileStr : String) : Integer;
var F : Integer;
    Found : Boolean;
begin
    Found := false;
    F := 0;

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

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

    result := F;
end;


procedure UpdateLicenses (const FilesList : tStringList); forward;

procedure PatternSearch (const FileStr : String);
var OK : Boolean;
    S1, S2: String;
    PFilesList : tStringList;
begin
    OK := RunCommand('/usr/libexec/lrc-find', [FileStr], S1,  [poUsePipes, poWaitOnExit]);

    If OK then
    begin
        PFilesList := tStringList.Create;

        // text import splits filenames with spaces or commas
        S2 := ReplaceStr (S1, ' ', '\');
        S1 := ReplaceStr (S2, ',', '"');

        PFilesList.text := S1;
        UpdateLicenses (PFilesList);
        PFilesList.free;
    end
    else
        writeln ('Pattern Search failed ',FileStr);
end;


// Change GPL3.0 to GPL3 etc, so strings match
Function AdjustGPL (LicenseStr : String) : String;
begin
    iF StartsStr ('GPL', LicenseStr)
    and (FindPart ('.0', LicenseStr) <> 0) then
    begin
        LicenseStr := DelChars (LicenseStr, '.');
        LicenseStr := DelChars (LicenseStr, '0');
    end;

    result := LicenseStr;
end;


procedure UpdateLicenses (const FilesList : tStringList);
var F,C,W, Len : Integer;
    FileStr,
    LicenseStr : String;
begin
    Len := 2 + Length ('License:');
    LicenseStr := TrimLeft (TrimRight (AdjustGPL (ExtractSubstr (crline, Len, []))));

    For C := 0 to FilesList.Count-1 do
    begin
        for W := 1 to WordCount (FilesList.Strings[C], WhiteSpace+[',']) do
        begin
            FileStr := ExtractWord (W, FilesList.Strings[C], WhiteSpace+[',']);

            if (Pos ('*', FileStr) <> 0) or (Pos ('?', FileStr) <> 0) then
                PatternSearch (FileStr)
            else
            begin
                F := FindThisFile (FileStr);
                if F >= 0 then
                     MyFiles [F].Dep5 := LicenseStr;
             end;
        end;
   end;
end;


Procedure CheckFilesPara;
var Posn : Integer;
    Done : Boolean;
    FilesStr : String;
    FilesList : tStringList;
begin
    FilesList := tStringList.Create;

    posn     := 1+Length ('Files:');
    FilesStr := ExtractSubstr (crline, Posn, []);
    FilesStr := TrimLeftSet (FilesStr, WhiteSpace);

    FilesList.Add (FilesStr);

    Done := false;
    while not Done do
    begin
        Readln (cfile, crline);

        if CheckLine in [fBlank, fEOF] then
            Done := true
        else
        if (lastField = fCopyRight) or (lastField = fComment) then
            // skip, only tracking licenses
        else
        if CheckLine = fContinue then
        begin
            Removeleadingchars (crline, WhiteSpace);
            FilesList.Add (crline);
        end
        else
        if CheckLine = fLicense then
        begin
            UpdateLicenses (FilesList);
            Done := true;
        end;
    end;

    FilesList.Clear;
    FilesList.Free;

    repeat Readln (cfile, crline);
    until CheckLine in [fBlank, fEOF];
end;


function CheckHeader : Boolean;
begin
    Readln (cfile, crline);

    if CheckLine <> fFormat then
        result := false
    else
    begin
        result := true;
        repeat Readln (cfile, crline);
        until CheckLine in [fFiles, fBlank, fEOF];

        if lastField = fFiles then
            CheckFilesPara;
    end;
end;


Procedure LicensePara; // Ignore contents
begin
    repeat Readln (cfile, crline);
    until CheckLine in [fBlank, fEOF];
end;

procedure CheckPara;
begin
    Readln (cfile, crline);

    if CheckLine = fFiles then
        CheckFilesPara
    else
    if CheckLine = fLicense then
        LicensePara
end;

function CheckFile : Boolean;
begin
    If CheckHeader then
    begin
        result := true;
        While NOT EOF (cfile) do
            CheckPara;
    end
    else
    begin
        result := false;
        Writeln ('Invalid DEP-5 header in  debian/copyright');
    end
end;

function OpenFile (Name : String; var Myfile : text) : Boolean;
begin
    result := true;
    try
        AssignFile (Myfile, Name);
        Reset (Myfile);
    except
        result := false;
        Writeln ('Failed to open ', Name);
    end;
end;

function CopyRightFile : Boolean;
begin
    If OpenFile ('debian/copyright', cfile) then
        if not CheckFile then
        begin
            Writeln ('Failed to process debian/copyright');
            result := false;
        end
        else
            result := true
    else
        result := false;
end;
