File Coverage

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

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