// Reconcile DEP-5 debian/copyright to licensecheck report on source tree
//
// Copyright : 2023 P Blackman
// License   : BSD-2-clause
//

program lrc;
{$mode delphi}
{$linklib c}

Uses StrUtils, SysUtils, Process, Classes;

const WhiteSpace :  set of Char = [' ',Chr(9)]; // Space & Tab

type
    tFileLic =
    record
        FName : AnsiString;
        Dep5,
        Actual : String;
    end;

var
    MyFiles : array of tFileLic;


procedure MangleName (var Nam : AnsiString);
begin
    Nam := ReplaceStr (Nam, ' ', '\1'); // maybe spaces in filenames (segments then treated as separate files!)
    Nam := ReplaceStr (Nam, ',', '\2'); // commas are problems too
    Nam := ReplaceStr (Nam, '£', '\3');
    Nam := ReplaceStr (Nam, '*', '\4'); // wildcards
    Nam := ReplaceStr (Nam, '?', '\5'); // wildcard
end;

procedure UnMangleName (var Nam : AnsiString);
begin
    Nam := ReplaceStr (Nam, '\1', ' ');
    Nam := ReplaceStr (Nam, '\2', ',');
    Nam := ReplaceStr (Nam, '\3', '£');
    Nam := ReplaceStr (Nam, '\4', '*');
    Nam := ReplaceStr (Nam, '\5', '?');
end;

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

{$INCLUDE options.pp}

procedure LoadSource;
var C, Posn     : Integer;
    OK          : Boolean;
    Line, S1    : AnsiString;
    SourceList  : tStringList;
begin
    if not Option_Struct then
    begin
        Writeln;
        Writeln ('Parsing Source Tree ....');
    end;

    OK := RunCommand('/usr/libexec/lrc-find', ['.'], S1,  [poUsePipes, poWaitOnExit]);

    if not OK then
        writeln ('Failed to parse source tree')
    else
    begin
        MangleName (S1);
        SourceList := tStringList.Create;
        SourceList.text := S1;

        SetLength (MyFiles, SourceList.Count);
        for C := 0 to SourceList.Count -1 do
        begin
            Posn             := 3; // Strip leading ./
            Line             := SourceList.Strings[C];
            MyFiles[C].Fname := ExtractSubstr (Line, Posn, []);
            MyFiles[C].Dep5  := '';
            MyFiles[C].Actual:= '';
        end;

        SourceList.free;
    end;
end;


procedure LicenseCheck;
var L, Posn, Count : Integer;
    OK, Match : Boolean;
    Line, S,
    FileName,
    License : String;
    LicenseList : tStringList;

begin
    if not Option_Struct then
        Writeln ('Running licensecheck ....');
    OK := RunCommand('/usr/libexec/lrc-lc', [], S,  [poUsePipes, poWaitOnExit]);

    if not OK then
        writeln ('Failed to run licensecheck')
    else
    begin
        Writeln;
        LicenseList := tStringList.Create;
        LicenseList.text := s;
        Count := 0;

        // Unmangle filenames
        for Count := 0 to High (MyFiles) do
            Unmanglename (MyFiles[Count].Fname);

        for L := 0 to LicenseList.Count -1 do
        begin
            Line := LicenseList.Strings [L];
            Posn      := 4; // Strip leading .//
            FileName := ExtractSubstr (Line, Posn, [Chr(9)]);
            License  := ExtractSubstr (Line, Posn, []);

            Count := 0;
            Match    := FileName = MyFiles[Count].Fname;
            While not Match and (count < High (MyFiles)) do
            begin
                Count := Count +1;
                Match := FileName = MyFiles[Count].Fname;
            end;

            If match then
                MyFiles[Count].Actual := License
            else
                Writeln (FileName,' has unused license ', License);
        end;
        LicenseList.free;
    end;
end;

// These files often contain licenses for other files
function IgnoreFile (Fname : AnsiString) : Boolean;
var FullName, ShortName, FileExt : AnsiString;
begin
    Fullname := ExtractFileName(Fname);

    FileExt := ExtractFileExt (FullName);

    if FileExt = '' then
        Shortname := FullName
    else
        ShortName := ReplaceStr( Fullname, FileExt, '');

    result := ContainsText (ShortName, 'copyright') or
              ContainsText (ShortName, 'copying') or
              ContainsText (ShortName, 'license') or
              ContainsText (ShortName, 'readme') or
              ContainsText (ShortName, 'authors') or
              ContainsText (ShortName, 'about') or
              ContainsText (ShortName, 'appdata') or
              ContainsText (ShortName, 'metainfo') or
              ContainsText (ShortName, 'dep5');
end;

{$INCLUDE gpl.pp}
{$INCLUDE dep5.pp}

procedure Compare;
var F : tFileLic;
    Header,
    GotOne : Boolean;
    last_Dep5,
    Last_Actual : String;
begin
    Header := False;
    GotOne := False;
    Last_Dep5 := '';
    Last_Actual := '';

    for F in MyFiles do
        with F do
            if (Actual <> '') and ((CompareText(Dep5, Actual) <> 0) or Option_Long) then
                if not IgnoreFile (Fname)
                and (not CheckGPL (Fname, Dep5, Actual) or Option_Long) then
                begin
                    if not Header and not Option_Struct then
                    begin
                        Writeln ('d/copyright     | licensecheck');
                        Writeln;
                        Header := True;
                    end;
                    GotOne := GotOne or (CompareText(Dep5, Actual) <> 0);

                    if Option_Terse and (Dep5 = last_Dep5) and (Actual = Last_Actual) then
                        // skip the file
                    else
                    if Option_Struct then
                    begin
                        Writeln (Dep5);
                        Writeln (Actual);
                        Writeln (FName);
                        Writeln;
                    end
                    else
                        Writeln (PadRight(Dep5,16), '| ', PadRight(Actual,16), ' ',FName);

                    Last_Dep5 := Dep5;
                    Last_Actual := Actual;
                end;

    if GotOne then
    begin
        Writeln;
        Halt (3);
    end
    else
    if not Option_Struct then
        Writeln ('No differences found');
end;


begin
    if not FileExists ('debian/copyright') then
    begin
        Writeln ('Cannot find the file; debian/copyright');
        Halt (1);
    end
    else
    begin
        GetOptions;

        if not Option_Struct or Option_Version then
            ShowVersions;

        if Option_Help then
            ShowHelp
        else
        if Option_Version and not Option_Struct then
            // stop here
        else
        begin
            LoadSource;    // Read in source tree

            if CopyRightFile then // Parse debian/copyright
            begin
                LicenseCheck;  // get licenses from licensecheck
                Compare;
            end
            else
                Halt (1);
        end;
    end;
end.
