// Reconcile DEP-5 debian/copyright to licensecheck
//
// Copyright : 2023-2024 P Blackman
// License   : BSD-2-clause
//
// Parsing of DEP-5 copyright file

unit dep5;
{$mode delphi}

interface uses support;

var
    MyFiles : tFileLicArray;

function CopyRightFile : Boolean;


implementation uses StrUtils, SysUtils, Process, Classes, gpl, options, rstrings;

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

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

// Process one line from d/copyright
function CheckLine : ftype;
begin
    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 EOF (cfile ) then
        result := fEOF
    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;


// locate a file from d/copyright, find its index in the source file array
function FindThisFile (const FileStr : AnsiString) : 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 ('** ' + rsSfp + ' ', FileStr); // Superfluous file pattern
        F := -1;
    end;

    result := F;
end;


// True if string has a single asterisk
function SingleAsterisk (Str : string) : Boolean;
var I, Count : Integer;
begin
    Count := 0;

    for I := 1 to length (Str) do
        if Str [I] = '*' then
            inc (Count);

    result := Count=1;
end;

// use * to match anything in a file name string
// Effects a recursive directory match
procedure SearchFileList (Str : String; out S1 : AnsiString);
var F, P : Integer;
    BStr, EStr : String;
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 F := low (MyFiles) to high (MyFiles) do
      with MyFiles[F] do
        if  StartsStr (BStr, FName)
        and EndsStr   (EStr, FName) then
            S1 := S1 + FName + LineEnding;
end;


procedure UpdateLicenses (const FilesList : tStringList); forward;

procedure PatternSearch (FileStr : AnsiString);
var OK : Boolean;
    S1 : AnsiString;
    PFilesList : tStringList;
begin
    if FileStr = '*' then
        FileStr := '.'; // Using * here misses top level hidden folders

    if SingleAsterisk (FileStr) then
    begin
        SearchFileList (FileStr, S1);
        OK := True;
    end
    else
        OK := RunCommand('/usr/libexec/lrc-find', [FileStr], S1,  [poUsePipes, poWaitOnExit]);

    If OK then
    begin
        PFilesList := tStringList.Create;
        MangleName (S1);
        PFilesList.text := S1;
        UpdateLicenses (PFilesList);
        PFilesList.Free;
     end
     else
        writeln ('Pattern Search failed ',FileStr);
end;


procedure UpdateLicenses (const FilesList : tStringList);
var F,C,W,P,Len : Integer;
    FileStr     : AnsiString;
    LicenseStr  : String;
begin
    Len := 1 + Length ('License:');
    LicenseStr := TrimRight (AdjustGPL (TrimLeft(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 LeftStr (FileStr, 2) = './' then
            begin
                // Strip leading ./
                P := 3;
                FileStr := ExtractSubstr (FileStr, P, []);
            end;

            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;


// Note a group of files, and their associated license
Procedure CheckFilesPara;
var Posn : Integer;
    Done : Boolean;
    FilesStr : AnsiString;
    FilesList : tStringList;
begin
    FilesList := tStringList.Create;

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

    FilesList.Add (FilesStr);

    if NOT DebianFilesPara then
        DebianFilesPara := StartsStr( 'debian/', 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);

            if NOT DebianFilesPara then
                DebianFilesPara := StartsStr( 'debian/', crline);
        end
        else
        if CheckLine = fLicense then
        begin
            UpdateLicenses (FilesList);
            Done := true;
        end;
    end;

    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; // Skip, ignoring 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
    DebianFilesPara := False;

    if not Option_Struct then
        Writeln (rsRC + ' d/copyright  ....'); // Reading copyright
    If CheckHeader then
    begin
        result := true;
        While NOT EOF (cfile) do
            CheckPara;

        if NOT DebianFilesPara then
            Writeln ('  ' + rsMFP + ' debian/'); // Missing Files Paragraph for
    end
    else
    begin
        result := false;
        Writeln (rsID5 + ' debian/copyright'); // Invalid DEP-5 header in
    end
end;


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

end.
