File: filedata.pas

package info (click to toggle)
licenserecon 12.0
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 372 kB
  • sloc: pascal: 1,375; makefile: 33; perl: 31; xml: 9; sh: 2
file content (224 lines) | stat: -rw-r--r-- 6,443 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
// Reconcile DEP-5 debian/copyright to licensecheck
//
// Copyright : 2025-2026 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;
begin
    SetLength (MyFiles, SourceList.Count);

    for C := 0 to SourceList.Count -1 do
        with MyFiles[C] do
        begin
	    Posn := 3; // Strip leading ./
            Fname     := ExtractSubstr (SourceList.Strings[C], Posn, []);
            Dep5      := '';
            Actual    := '';
            PathDepth := 0;
            GlobCount := 0;
        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.