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
|
#line 1
package Module::Install::Repository;
use strict;
use 5.005;
use vars qw($VERSION);
$VERSION = '0.06';
use base qw(Module::Install::Base);
sub _execute {
my ($command) = @_;
`$command`;
}
sub auto_set_repository {
my $self = shift;
return unless $Module::Install::AUTHOR;
my $repo = _find_repo(\&_execute);
if ($repo) {
$self->repository($repo);
} else {
warn "Cannot determine repository URL\n";
}
}
sub _find_repo {
my ($execute) = @_;
if (-e ".git") {
# TODO support remote besides 'origin'?
if ($execute->('git remote show -n origin') =~ /URL: (.*)$/m) {
# XXX Make it public clone URL, but this only works with github
my $git_url = $1;
$git_url =~ s![\w\-]+\@([^:]+):!git://$1/!;
return $git_url;
} elsif ($execute->('git svn info') =~ /URL: (.*)$/m) {
return $1;
}
} elsif (-e ".svn") {
if (`svn info` =~ /URL: (.*)$/m) {
return $1;
}
} elsif (-e "_darcs") {
# defaultrepo is better, but that is more likely to be ssh, not http
if (my $query_repo = `darcs query repo`) {
if ($query_repo =~ m!Default Remote: (http://.+)!) {
return $1;
}
}
open my $handle, '<', '_darcs/prefs/repos' or return;
while (<$handle>) {
chomp;
return $_ if m!^http://!;
}
} elsif (-e ".hg") {
if ($execute->('hg paths') =~ /default = (.*)$/m) {
my $mercurial_url = $1;
$mercurial_url =~ s!^ssh://hg\@(bitbucket\.org/)!https://$1!;
return $mercurial_url;
}
} elsif (-e "$ENV{HOME}/.svk") {
# Is there an explicit way to check if it's an svk checkout?
my $svk_info = `svk info` or return;
SVK_INFO: {
if ($svk_info =~ /Mirrored From: (.*), Rev\./) {
return $1;
}
if ($svk_info =~ m!Merged From: (/mirror/.*), Rev\.!) {
$svk_info = `svk info /$1` or return;
redo SVK_INFO;
}
}
return;
}
}
1;
__END__
=encoding utf-8
#line 128
|
