File Coverage

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

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