// 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;

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 ('** Superfluous file pattern ',FileStr);
        F := -1;
    end;

    result := F;
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

    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 := 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 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);
        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 ('Reading copyright    ....');
    If CheckHeader then
    begin
        result := true;
        While NOT EOF (cfile) do
            CheckPara;

        if NOT DebianFilesPara then
            Writeln ('  Missing Files Paragraph for debian/');
    end
    else
    begin
        result := false;
        Writeln ('Invalid DEP-5 header in  debian/copyright');
    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.
