File Coverage

File:lib/CheckSpelling/SummaryTables.pm
Coverage:83.6%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2package CheckSpelling::SummaryTables;
3
4
1
1
1
1
116705
1
5
use utf8;
5
1
1
1
1
25
1
42
use Cwd 'abs_path';
6
1
1
1
1
1
1
30
use File::Basename;
7
1
1
1
1
2
1
20
use File::Temp qw/ tempfile tempdir /;
8
1
1
1
1
1
1
22
use JSON::PP;
9
1
1
1
1
229
1
19
use CheckSpelling::Util;
10
1
1
1
1
192
1
518
use CheckSpelling::GitSources;
11
12
1
1
1
1
2
0
18
unless (eval 'use URI::Escape; 1') {
13    eval 'use URI::Escape::XS qw/uri_escape/';
14}
15
16my $pull_base;
17my $pull_head;
18
19sub file_ref {
20
1
1
252
    my ($file, $line) = @_;
21
1
4
    $file =~ s/ /%20/g;
22
1
4
    return "$file:$line";
23}
24
25sub github_blame {
26
17
17
34511
    my ($file, $line) = @_;
27
17
9
    our (%git_roots, %github_urls, $pull_base, $pull_head);
28
29
17
50
32
    return file_ref($file, $line) if ($file =~ m{^https?://});
30
31
17
51
    my ($parsed_file, $git_base_dir, $prefix, $remote_url, $rev) = CheckSpelling::GitSources::git_source_and_rev($file);
32
17
50
12
    return file_ref($file, $line) unless defined $prefix;
33
17
50
31
    my $line_delimiter = $prefix =~ m<https?://> ? '#L' : ':';
34
35
17
21
    $file = uri_escape($parsed_file, "^A-Za-z0-9\-\._~/");
36
17
197
    return "$prefix$file$line_delimiter$line";
37}
38
39sub main {
40
4
4
8130
    binmode(STDOUT, ":encoding(UTF-8)");
41
4
64
    my $budget = CheckSpelling::Util::get_val_from_env("summary_budget", "");
42
4
68
    print STDERR "Summary Tables budget: $budget\n";
43
4
6
    my $summary_tables = tempdir();
44
4
525
    my $table;
45    my @tables;
46
47
4
9
    my $head_ref = CheckSpelling::Util::get_file_from_env('GITHUB_HEAD_REF', "");
48
4
4
    my $github_url = CheckSpelling::Util::get_file_from_env('GITHUB_SERVER_URL', "");
49
4
5
    my $github_repository = CheckSpelling::Util::get_file_from_env('GITHUB_REPOSITORY', "");
50
4
3
    my $event_file_path = CheckSpelling::Util::get_file_from_env('GITHUB_EVENT_PATH', "");
51
4
50
20
21
    if ($head_ref && $github_url && $github_repository && $event_file_path) {
52
4
50
52
        if (open $event_file_handle, '<', $event_file_path) {
53
4
7
            local $/;
54
4
32
            my $json = <$event_file_handle>;
55
4
13
            close $event_file_handle;
56
4
11
            my $data = decode_json($json);
57
4
1428
            our $pull_base = "$github_url/$github_repository";
58
4
4
            our $pull_head = "$github_url/".$data->{'pull_request'}->{'head'}->{'repo'}->{'full_name'};
59
4
100
50
25
            unless ($pull_head && $pull_base && ($pull_base ne $pull_head)) {
60
2
5
                $pull_base = $pull_head = '';
61            }
62        }
63    }
64
65
4
20
    while (<>) {
66
18
100
97
        next unless m{^(.+):(\d+):(\d+) \.\.\. (\d+),\s(Error|Warning|Notice)\s-\s(.+)\s\(([-a-z]+)\)$};
67
15
32
        my ($file, $line, $column, $endColumn, $severity, $message, $code) = ($1, $2, $3, $4, $5, $6, $7);
68
15
13
        my $table_file = "$summary_tables/$code";
69
15
100
86
        push @tables, $code unless -e $table_file;
70
15
240
        open $table, ">>", $table_file;
71
15
14
        $message =~ s/\|/\\|/g;
72
15
13
        my $blame = CheckSpelling::SummaryTables::github_blame($file, $line);
73
15
34
        print $table "$message | $blame\n";
74
15
209
        close $table;
75    }
76
4
100
6
    return unless @tables;
77
78
3
7
    my ($details_prefix, $footer, $suffix, $need_suffix) = (
79        "<details><summary>Details 🔎</summary>\n\n",
80        "</details>\n\n",
81        "\n</details>\n\n",
82        0
83    );
84
3
3
    my $footer_length = length $footer;
85
3
50
2
    if ($budget) {
86
3
5
        $budget -= (length $details_prefix) + (length $suffix);
87
3
22
        print STDERR "Summary Tables budget reduced to: $budget\n";
88    }
89
3
7
    for $table_file (sort @tables) {
90
9
6
        my $header = "<details><summary>📂 $table_file</summary>\n\n".
91            "note|path\n".
92            "-|-\n";
93
9
7
        my $header_length = length $header;
94
9
4
        my $file_path = "$summary_tables/$table_file";
95
9
28
        my $cost = $header_length + $footer_length + -s $file_path;
96
9
100
67
14
        if ($budget && ($budget < $cost)) {
97
7
21
            print STDERR "::warning title=summary-table::Details for '$table_file' too big to include in Step Summary (summary-table-skipped)\n";
98
7
6
            next;
99        }
100
2
19
        open $table, "<:encoding(UTF-8)", $file_path;
101
2
39
        my @entries;
102
2
2
        my $real_cost = $header_length + $footer_length;
103
2
16
        foreach my $line (<$table>) {
104
2
11
            $real_cost += length $line;
105
2
2
            push @entries, $line;
106        }
107
2
8
        close $table;
108
2
50
3
        if ($real_cost > $cost) {
109
0
0
            print STDERR "budget ($real_cost > $cost)\n";
110
0
0
0
0
            if ($budget && ($budget < $real_cost)) {
111
0
0
                print STDERR "::warning title=summary-tables::budget exceeded for $table_file (summary-table-skipped)\n";
112
0
0
                next;
113            }
114        }
115
2
100
4
        if ($details_prefix ne '') {
116
1
13
            print $details_prefix;
117
1
2
            $details_prefix = '';
118
1
0
            $need_suffix = 1;
119        }
120
2
7
        print $header;
121
2
12
        print join ("", sort CheckSpelling::Util::case_biased @entries);
122
2
6
        print $footer;
123
2
50
6
        if ($budget) {
124
2
1
            $budget -= $cost;
125
2
6
            print STDERR "Summary Tables budget reduced to: $budget\n";
126        }
127    }
128
3
100
15
    print $suffix if $need_suffix;
129}
130
1311;