package Module::Install::Repository; use strict; use 5.005; use vars qw($VERSION); $VERSION = '0.08'; 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") { foreach my $name (qw(origin github)) { my $git_output = $execute->("git remote show -n $name"); if ($git_output =~ /Tracked remote branch/ && $git_output =~ /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; } } if ($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 =for stopwords github.com META.yml Darcs =head1 NAME Module::Install::Repository - Automatically sets repository URL from svn/svk/Git checkout =head1 SYNOPSIS # in Makefile.PL use inc::Module::Install; auto_set_repository; =head1 DESCRIPTION Module::Install::Repository is a Module::Install plugin to automatically figure out repository URL and set it via I which then will be added to resources under I. =head1 CAVEATS The regular expression to rewrite Git repository URL to public clone URL is dependent on the server side directory layout, which means this module currently works only with github.com style. =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE Darcs support by Shawn M Moore git-svn support by Tokuhiro Matsuno =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =cut