File Coverage

File:lib/CheckSpelling/GitSources.pm
Coverage:76.3%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2package CheckSpelling::GitSources;
3
4
3
3
3
3
111756
3
79
use Cwd 'abs_path';
5
3
3
3
3
7
2
75
use File::Basename;
6
3
3
3
3
38
4
63
use File::Temp qw/ tempfile tempdir /;
7
3
3
3
3
3
2
50
use JSON::PP;
8
3
3
3
3
151
3
1534
use CheckSpelling::Util;
9
10
3
3
3
3
432
2139
58
unless (eval 'use URI::Escape; 1') {
11    eval 'use URI::Escape::XS qw/uri_escape/';
12}
13
14my %git_roots = ();
15my %github_urls = ();
16my $pull_base;
17my $pull_head;
18
19sub github_repo {
20
3
3
201
    my ($source) = @_;
21
3
18
    $source =~ s<https://[^/]+/|.*:><>;
22
3
4
    $source =~ s<\.git$><>;
23
3
100
9
    return '' unless $source =~ m#^[^/]+/[^/]+$#;
24
2
6
    return $source;
25}
26
27sub file_ref {
28
0
0
0
    my ($file, $line) = @_;
29
0
0
    $file =~ s/ /%20/g;
30
0
0
    return "$file:$line";
31}
32
33sub find_git {
34
6
6
12
    our $git_dir;
35
6
100
17
    return $git_dir if defined $git_dir;
36
3
50
25
    if ($ENV{PATH} =~ /(.*)/) {
37
3
4
        my $path = $1;
38
3
11
        for my $maybe_git (split /:/, $path) {
39
33
100
88
            if (-x "$maybe_git/git") {
40
3
2
                $git_dir = $maybe_git;
41
3
31
                return $git_dir;
42            }
43        }
44    }
45}
46
47sub git_source_and_rev {
48
26
26
698350
    my ($file) = @_;
49
26
16
    our (%git_roots, %github_urls, $pull_base, $pull_head);
50
51
26
25
    my $last_git_dir;
52
26
15
    my $dir = $file;
53
26
16
    my @children;
54
26
33
106
    while ($dir ne '.' && $dir ne '/') {
55
37
479
        my $child = basename($dir);
56
37
32
        push @children, $child;
57
37
253
        my $parent = dirname($dir);
58
37
50
32
        last if $dir eq $parent;
59
37
22
        $dir = $parent;
60
37
100
45
        last if defined $git_roots{$dir};
61
16
11
        my $git_dir = "$dir/.git";
62
16
100
109
        if (-e $git_dir) {
63
6
100
20
            if (-d $git_dir) {
64
5
13
                $git_roots{$dir} = $git_dir;
65
5
6
                last;
66            }
67
1
50
22
            if (-s $git_dir) {
68
1
28
                open $git_dir_file, '<', $git_dir;
69
1
7
                my $git_dir_path = <$git_dir_file>;
70
1
3
                close $git_dir_file;
71
1
50
5
                if ($git_dir_path =~ /^gitdir: (.*)$/) {
72
1
26
                    $last_git_dir = $git_roots{$dir} = abs_path("$dir/$1");
73                }
74            }
75        }
76    }
77
26
67
67
    $last_git_dir ||= $git_roots{$dir};
78
26
21
    my $length = scalar @children - 1;
79
26
30
    for (my $i = 0; $i < $length; $i++) {
80
11
8
        $dir .= "/$children[$i]";
81
11
14
        $git_roots{$dir} = $last_git_dir;
82    }
83
84
26
50
19
    return () unless defined $last_git_dir;
85
26
29
    $file = join '/', (reverse @children);
86
87
26
14
    my ($prefix, $remote_url, $rev, $branch);
88
26
100
28
    unless (defined $github_urls{$last_git_dir}) {
89
6
11
        my $full_path = $ENV{PATH};
90
6
13
        $ENV{PATH} = find_git();
91
6
7
        my $git_dir = $ENV{GIT_DIR};
92
6
46
        $ENV{GIT_DIR} = $last_git_dir;
93
6
14269
        my $git_remotes = `git remote`;
94
6
53
        my @remotes = split /\n/, $git_remotes;
95
6
6
        my $origin;
96
6
7
50
0
33
55
        if (grep { /^origin$/ } @remotes) {
97
6
14
            $origin = 'origin';
98        } elsif (@remotes) {
99
0
0
            $origin = $remotes[0];
100        }
101
6
8
        my $remote_url;
102        my $rev;
103
6
50
12
        if ($origin) {
104
6
17349
            $remote_url = `git remote get-url "$origin" 2>/dev/null`;
105
6
34
            chomp $remote_url;
106
6
17048
            $rev = `git rev-parse HEAD 2>/dev/null`;
107
6
57
            chomp $rev;
108
6
12
            my $private_synthetic_sha = $ENV{PRIVATE_SYNTHETIC_SHA};
109
6
50
24
            if (defined $private_synthetic_sha) {
110
0
0
0
                $rev = $ENV{PRIVATE_MERGE_SHA} if ($rev eq $private_synthetic_sha);
111            }
112        }
113
6
50
13303
        $branch = `git branch --show-current` unless $branch;
114
6
31
        chomp $branch;
115
6
66
        $ENV{PATH} = $full_path;
116
6
50
32
        if ($git_dir) {
117
0
0
            $ENV{GIT_DIR} = $git_dir;
118        } else {
119
6
49
            delete $ENV{GIT_DIR};
120        }
121
6
7
        my $url_base;
122
6
50
15
        $remote_url = '' if $remote_url eq '.';
123
6
50
0
0
14
        if ($remote_url) {
124
6
100
70
            unless ($remote_url =~ m<^https?://>) {
125
2
26
                $remote_url =~ s!.*\@([^:]+):!https://$1/!;
126            }
127
6
20
            $remote_url =~ s!\.git$!!;
128        } elsif ($ENV{GITHUB_SERVER_URL} ne '' && $ENV{GITHUB_REPOSITORY} ne '') {
129
0
0
            $remote_url = "$ENV{GITHUB_SERVER_URL}/$ENV{GITHUB_REPOSITORY}";
130
0
0
0
0
            $rev = $ENV{GITHUB_HEAD_REF} || $ENV{GITHUB_SHA} unless $rev;
131
0
0
0
            $branch = $ENV{GITHUB_HEAD_REF} unless $branch;
132        }
133
6
50
17
        $url_base = "$remote_url/blame" if $remote_url;
134
6
50
8
        if ($url_base) {
135
6
50
9
            if ($pull_base) {
136
0
0
                $url_base =~ s<^$pull_base/><$pull_head/>i;
137            }
138
6
11
            $prefix = "$url_base/$rev/";
139        }
140
141
6
60
        $github_urls{$last_git_dir} = [$prefix, $remote_url, $rev, $branch];
142    }
143
26
100
577
    my $real_last_git_dir = basename($last_git_dir) eq '.git' ? dirname($last_git_dir) : $last_git_dir;
144
26
26
18
102
    return $file, $real_last_git_dir, @{$github_urls{$last_git_dir}};
145}
146
1471;