summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/.gitignore2
-rw-r--r--perl/Git.pm360
-rw-r--r--perl/Git/I18N.pm98
-rw-r--r--perl/Makefile23
-rw-r--r--perl/Makefile.PL22
5 files changed, 429 insertions, 76 deletions
diff --git a/perl/.gitignore b/perl/.gitignore
index 98b24772c7..d5c6e22d0f 100644
--- a/perl/.gitignore
+++ b/perl/.gitignore
@@ -1,5 +1,7 @@
perl.mak
perl.mak.old
+MYMETA.json
+MYMETA.yml
blib
blibdirs
pm_to_blib
diff --git a/perl/Git.pm b/perl/Git.pm
index 97e61efaff..497f420178 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -7,6 +7,7 @@ Git - Perl interface to the Git version control system
package Git;
+use 5.008;
use strict;
@@ -56,7 +57,9 @@ require Exporter;
@EXPORT_OK = qw(command command_oneline command_noisy
command_output_pipe command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe
- version exec_path hash_object git_cmd_try);
+ version exec_path html_path hash_object git_cmd_try
+ remote_refs
+ temp_acquire temp_release temp_reset temp_path);
=head1 DESCRIPTION
@@ -89,16 +92,16 @@ TODO: In the future, we might also do
Currently, the module merely wraps calls to external Git tools. In the future,
it will provide a much faster way to interact with Git by linking directly
to libgit. This should be completely opaque to the user, though (performance
-increate nonwithstanding).
+increase notwithstanding).
=cut
use Carp qw(carp croak); # but croak is bad - throw instead
use Error qw(:try);
-use Cwd qw(abs_path);
+use Cwd qw(abs_path cwd);
use IPC::Open2 qw(open2);
-
+use Fcntl qw(SEEK_SET SEEK_CUR);
}
@@ -164,12 +167,13 @@ sub repository {
}
}
- if (not defined $opts{Repository} and not defined $opts{WorkingCopy}) {
- $opts{Directory} ||= '.';
+ if (not defined $opts{Repository} and not defined $opts{WorkingCopy}
+ and not defined $opts{Directory}) {
+ $opts{Directory} = '.';
}
- if ($opts{Directory}) {
- -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
+ if (defined $opts{Directory}) {
+ -d $opts{Directory} or throw Error::Simple("Directory not found: $opts{Directory} $!");
my $search = Git->repository(WorkingCopy => $opts{Directory});
my $dir;
@@ -182,7 +186,7 @@ sub repository {
if ($dir) {
$dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
- $opts{Repository} = $dir;
+ $opts{Repository} = abs_path($dir);
# If --git-dir went ok, this shouldn't die either.
my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
@@ -201,15 +205,15 @@ sub repository {
$dir = $opts{Directory};
unless (-d "$dir/refs" and -d "$dir/objects" and -e "$dir/HEAD") {
- # Mimick git-rev-parse --git-dir error message:
- throw Error::Simple('fatal: Not a git repository');
+ # Mimic git-rev-parse --git-dir error message:
+ throw Error::Simple("fatal: Not a git repository: $dir");
}
my $search = Git->repository(Repository => $dir);
try {
$search->command('symbolic-ref', 'HEAD');
} catch Git::Error::Command with {
- # Mimick git-rev-parse --git-dir error message:
- throw Error::Simple('fatal: Not a git repository');
+ # Mimic git-rev-parse --git-dir error message:
+ throw Error::Simple("fatal: Not a git repository: $dir");
}
$opts{Repository} = abs_path($dir);
@@ -392,7 +396,16 @@ See C<command_close_bidi_pipe()> for details.
sub command_bidi_pipe {
my ($pid, $in, $out);
+ my ($self) = _maybe_self(@_);
+ local %ENV = %ENV;
+ my $cwd_save = undef;
+ if ($self) {
+ shift;
+ $cwd_save = cwd();
+ _setup_git_cmd_env($self);
+ }
$pid = open2($in, $out, 'git', @_);
+ chdir($cwd_save) if $cwd_save;
return ($pid, $in, $out, join(' ', @_));
}
@@ -416,6 +429,7 @@ have more complicated structure.
=cut
sub command_close_bidi_pipe {
+ local $?;
my ($pid, $in, $out, $ctx) = @_;
foreach my $fh ($in, $out) {
unless (close $fh) {
@@ -488,6 +502,16 @@ C<git --exec-path>). Useful mostly only internally.
sub exec_path { command_oneline('--exec-path') }
+=item html_path ()
+
+Return path to the Git html documentation (the same as
+C<git --html-path>). Useful mostly only internally.
+
+=cut
+
+sub html_path { command_oneline('--html-path') }
+
+
=item repo_path ()
Return path to the git repository. Must be called on a repository instance.
@@ -531,7 +555,7 @@ sub wc_chdir {
or throw Error::Simple("bare repository");
-d $self->wc_path().'/'.$subdir
- or throw Error::Simple("subdir not found: $!");
+ or throw Error::Simple("subdir not found: $subdir $!");
# Of course we will not "hold" the subdirectory so anyone
# can delete it now and we will never know. But at least we tried.
@@ -546,30 +570,10 @@ does. In scalar context requires the variable to be set only one time
(exception is thrown otherwise), in array context returns allows the
variable to be set multiple times and returns all the values.
-This currently wraps command('config') so it is not so fast.
-
=cut
sub config {
- my ($self, $var) = _maybe_self(@_);
-
- try {
- my @cmd = ('config');
- unshift @cmd, $self if $self;
- if (wantarray) {
- return command(@cmd, '--get-all', $var);
- } else {
- return command_oneline(@cmd, '--get', $var);
- }
- } catch Git::Error::Command with {
- my $E = shift;
- if ($E->value() == 1) {
- # Key not found.
- return;
- } else {
- throw $E;
- }
- };
+ return _config_common({}, @_);
}
@@ -579,30 +583,33 @@ Retrieve the bool configuration C<VARIABLE>. The return value
is usable as a boolean in perl (and C<undef> if it's not defined,
of course).
-This currently wraps command('config') so it is not so fast.
-
=cut
sub config_bool {
- my ($self, $var) = _maybe_self(@_);
+ my $val = scalar _config_common({'kind' => '--bool'}, @_);
- try {
- my @cmd = ('config', '--bool', '--get', $var);
- unshift @cmd, $self if $self;
- my $val = command_oneline(@cmd);
- return undef unless defined $val;
+ # Do not rewrite this as return (defined $val && $val eq 'true')
+ # as some callers do care what kind of falsehood they receive.
+ if (!defined $val) {
+ return undef;
+ } else {
return $val eq 'true';
- } catch Git::Error::Command with {
- my $E = shift;
- if ($E->value() == 1) {
- # Key not found.
- return undef;
- } else {
- throw $E;
- }
- };
+ }
+}
+
+
+=item config_path ( VARIABLE )
+
+Retrieve the path configuration C<VARIABLE>. The return value
+is an expanded path or C<undef> if it's not defined.
+
+=cut
+
+sub config_path {
+ return _config_common({'kind' => '--path'}, @_);
}
+
=item config_int ( VARIABLE )
Retrieve the integer configuration C<VARIABLE>. The return value
@@ -611,22 +618,31 @@ or 'g' in the config file will cause the value to be multiplied
by 1024, 1048576 (1024^2), or 1073741824 (1024^3) prior to output.
It would return C<undef> if configuration variable is not defined,
-This currently wraps command('config') so it is not so fast.
-
=cut
sub config_int {
+ return scalar _config_common({'kind' => '--int'}, @_);
+}
+
+# Common subroutine to implement bulk of what the config* family of methods
+# do. This curently wraps command('config') so it is not so fast.
+sub _config_common {
+ my ($opts) = shift @_;
my ($self, $var) = _maybe_self(@_);
try {
- my @cmd = ('config', '--int', '--get', $var);
+ my @cmd = ('config', $opts->{'kind'} ? $opts->{'kind'} : ());
unshift @cmd, $self if $self;
- return command_oneline(@cmd);
+ if (wantarray) {
+ return command(@cmd, '--get-all', $var);
+ } else {
+ return command_oneline(@cmd, '--get', $var);
+ }
} catch Git::Error::Command with {
my $E = shift;
if ($E->value() == 1) {
# Key not found.
- return undef;
+ return;
} else {
throw $E;
}
@@ -668,6 +684,59 @@ sub get_color {
return $color;
}
+=item remote_refs ( REPOSITORY [, GROUPS [, REFGLOBS ] ] )
+
+This function returns a hashref of refs stored in a given remote repository.
+The hash is in the format C<refname =\> hash>. For tags, the C<refname> entry
+contains the tag object while a C<refname^{}> entry gives the tagged objects.
+
+C<REPOSITORY> has the same meaning as the appropriate C<git-ls-remote>
+argument; either a URL or a remote name (if called on a repository instance).
+C<GROUPS> is an optional arrayref that can contain 'tags' to return all the
+tags and/or 'heads' to return all the heads. C<REFGLOB> is an optional array
+of strings containing a shell-like glob to further limit the refs returned in
+the hash; the meaning is again the same as the appropriate C<git-ls-remote>
+argument.
+
+This function may or may not be called on a repository instance. In the former
+case, remote names as defined in the repository are recognized as repository
+specifiers.
+
+=cut
+
+sub remote_refs {
+ my ($self, $repo, $groups, $refglobs) = _maybe_self(@_);
+ my @args;
+ if (ref $groups eq 'ARRAY') {
+ foreach (@$groups) {
+ if ($_ eq 'heads') {
+ push (@args, '--heads');
+ } elsif ($_ eq 'tags') {
+ push (@args, '--tags');
+ } else {
+ # Ignore unknown groups for future
+ # compatibility
+ }
+ }
+ }
+ push (@args, $repo);
+ if (ref $refglobs eq 'ARRAY') {
+ push (@args, @$refglobs);
+ }
+
+ my @self = $self ? ($self) : (); # Ultra trickery
+ my ($fh, $ctx) = Git::command_output_pipe(@self, 'ls-remote', @args);
+ my %refs;
+ while (<$fh>) {
+ chomp;
+ my ($hash, $ref) = split(/\t/, $_, 2);
+ $refs{$ref} = $hash;
+ }
+ Git::command_close_pipe(@self, $fh, $ctx);
+ return \%refs;
+}
+
+
=item ident ( TYPE | IDENTSTR )
=item ident_person ( TYPE | IDENTSTR | IDENTARRAY )
@@ -676,7 +745,7 @@ This suite of functions retrieves and parses ident information, as stored
in the commit and tag objects or produced by C<var GIT_type_IDENT> (thus
C<TYPE> can be either I<author> or I<committer>; case is insignificant).
-The C<ident> method retrieves the ident information from C<git-var>
+The C<ident> method retrieves the ident information from C<git var>
and either returns it as a scalar string or as an array with the fields parsed.
Alternatively, it can take a prepared ident string (e.g. from the commit
object) and just parse it.
@@ -775,7 +844,7 @@ sub _open_hash_and_insert_object_if_needed {
($self->{hash_object_pid}, $self->{hash_object_in},
$self->{hash_object_out}, $self->{hash_object_ctx}) =
- command_bidi_pipe(qw(hash-object -w --stdin-paths));
+ $self->command_bidi_pipe(qw(hash-object -w --stdin-paths --no-filters));
}
sub _close_hash_and_insert_object {
@@ -785,8 +854,8 @@ sub _close_hash_and_insert_object {
my @vars = map { 'hash_object_' . $_ } qw(pid in out ctx);
- command_close_bidi_pipe($self->{@vars});
- delete $self->{@vars};
+ command_close_bidi_pipe(@$self{@vars});
+ delete @$self{@vars};
}
=item cat_blob ( SHA1, FILEHANDLE )
@@ -864,7 +933,7 @@ sub _open_cat_blob_if_needed {
($self->{cat_blob_pid}, $self->{cat_blob_in},
$self->{cat_blob_out}, $self->{cat_blob_ctx}) =
- command_bidi_pipe(qw(cat-file --batch));
+ $self->command_bidi_pipe(qw(cat-file --batch));
}
sub _close_cat_blob {
@@ -874,10 +943,158 @@ sub _close_cat_blob {
my @vars = map { 'cat_blob_' . $_ } qw(pid in out ctx);
- command_close_bidi_pipe($self->{@vars});
- delete $self->{@vars};
+ command_close_bidi_pipe(@$self{@vars});
+ delete @$self{@vars};
+}
+
+
+{ # %TEMP_* Lexical Context
+
+my (%TEMP_FILEMAP, %TEMP_FILES);
+
+=item temp_acquire ( NAME )
+
+Attempts to retreive the temporary file mapped to the string C<NAME>. If an
+associated temp file has not been created this session or was closed, it is
+created, cached, and set for autoflush and binmode.
+
+Internally locks the file mapped to C<NAME>. This lock must be released with
+C<temp_release()> when the temp file is no longer needed. Subsequent attempts
+to retrieve temporary files mapped to the same C<NAME> while still locked will
+cause an error. This locking mechanism provides a weak guarantee and is not
+threadsafe. It does provide some error checking to help prevent temp file refs
+writing over one another.
+
+In general, the L<File::Handle> returned should not be closed by consumers as
+it defeats the purpose of this caching mechanism. If you need to close the temp
+file handle, then you should use L<File::Temp> or another temp file faculty
+directly. If a handle is closed and then requested again, then a warning will
+issue.
+
+=cut
+
+sub temp_acquire {
+ my $temp_fd = _temp_cache(@_);
+
+ $TEMP_FILES{$temp_fd}{locked} = 1;
+ $temp_fd;
+}
+
+=item temp_release ( NAME )
+
+=item temp_release ( FILEHANDLE )
+
+Releases a lock acquired through C<temp_acquire()>. Can be called either with
+the C<NAME> mapping used when acquiring the temp file or with the C<FILEHANDLE>
+referencing a locked temp file.
+
+Warns if an attempt is made to release a file that is not locked.
+
+The temp file will be truncated before being released. This can help to reduce
+disk I/O where the system is smart enough to detect the truncation while data
+is in the output buffers. Beware that after the temp file is released and
+truncated, any operations on that file may fail miserably until it is
+re-acquired. All contents are lost between each release and acquire mapped to
+the same string.
+
+=cut
+
+sub temp_release {
+ my ($self, $temp_fd, $trunc) = _maybe_self(@_);
+
+ if (exists $TEMP_FILEMAP{$temp_fd}) {
+ $temp_fd = $TEMP_FILES{$temp_fd};
+ }
+ unless ($TEMP_FILES{$temp_fd}{locked}) {
+ carp "Attempt to release temp file '",
+ $temp_fd, "' that has not been locked";
+ }
+ temp_reset($temp_fd) if $trunc and $temp_fd->opened;
+
+ $TEMP_FILES{$temp_fd}{locked} = 0;
+ undef;
+}
+
+sub _temp_cache {
+ my ($self, $name) = _maybe_self(@_);
+
+ _verify_require();
+
+ my $temp_fd = \$TEMP_FILEMAP{$name};
+ if (defined $$temp_fd and $$temp_fd->opened) {
+ if ($TEMP_FILES{$$temp_fd}{locked}) {
+ throw Error::Simple("Temp file with moniker '" .
+ $name . "' already in use");
+ }
+ } else {
+ if (defined $$temp_fd) {
+ # then we're here because of a closed handle.
+ carp "Temp file '", $name,
+ "' was closed. Opening replacement.";
+ }
+ my $fname;
+
+ my $tmpdir;
+ if (defined $self) {
+ $tmpdir = $self->repo_path();
+ }
+
+ ($$temp_fd, $fname) = File::Temp->tempfile(
+ 'Git_XXXXXX', UNLINK => 1, DIR => $tmpdir,
+ ) or throw Error::Simple("couldn't open new temp file");
+
+ $$temp_fd->autoflush;
+ binmode $$temp_fd;
+ $TEMP_FILES{$$temp_fd}{fname} = $fname;
+ }
+ $$temp_fd;
+}
+
+sub _verify_require {
+ eval { require File::Temp; require File::Spec; };
+ $@ and throw Error::Simple($@);
}
+=item temp_reset ( FILEHANDLE )
+
+Truncates and resets the position of the C<FILEHANDLE>.
+
+=cut
+
+sub temp_reset {
+ my ($self, $temp_fd) = _maybe_self(@_);
+
+ truncate $temp_fd, 0
+ or throw Error::Simple("couldn't truncate file");
+ sysseek($temp_fd, 0, SEEK_SET) and seek($temp_fd, 0, SEEK_SET)
+ or throw Error::Simple("couldn't seek to beginning of file");
+ sysseek($temp_fd, 0, SEEK_CUR) == 0 and tell($temp_fd) == 0
+ or throw Error::Simple("expected file position to be reset");
+}
+
+=item temp_path ( NAME )
+
+=item temp_path ( FILEHANDLE )
+
+Returns the filename associated with the given tempfile.
+
+=cut
+
+sub temp_path {
+ my ($self, $temp_fd) = _maybe_self(@_);
+
+ if (exists $TEMP_FILEMAP{$temp_fd}) {
+ $temp_fd = $TEMP_FILEMAP{$temp_fd};
+ }
+ $TEMP_FILES{$temp_fd}{fname};
+}
+
+sub END {
+ unlink values %TEMP_FILEMAP if %TEMP_FILEMAP;
+}
+
+} # %TEMP_* Lexical Context
+
=back
=head1 ERROR HANDLING
@@ -1004,8 +1221,7 @@ either version 2, or (at your option) any later version.
# the method was called upon an instance and (undef, @args) if
# it was called directly.
sub _maybe_self {
- # This breaks inheritance. Oh well.
- ref $_[0] eq 'Git' ? @_ : (undef, @_);
+ UNIVERSAL::isa($_[0], 'Git') ? @_ : (undef, @_);
}
# Check if the command id is something reasonable.
@@ -1064,13 +1280,21 @@ sub _command_common_pipe {
# for the given repository and execute the git command.
sub _cmd_exec {
my ($self, @args) = @_;
+ _setup_git_cmd_env($self);
+ _execv_git_cmd(@args);
+ die qq[exec "@args" failed: $!];
+}
+
+# set up the appropriate state for git command
+sub _setup_git_cmd_env {
+ my $self = shift;
if ($self) {
$self->repo_path() and $ENV{'GIT_DIR'} = $self->repo_path();
+ $self->repo_path() and $self->wc_path()
+ and $ENV{'GIT_WORK_TREE'} = $self->wc_path();
$self->wc_path() and chdir($self->wc_path());
$self->wc_subdir() and chdir($self->wc_subdir());
}
- _execv_git_cmd(@args);
- die qq[exec "@args" failed: $!];
}
# Execute the given Git command ($_[0]) with arguments ($_[1..])
diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm
new file mode 100644
index 0000000000..40dd897191
--- /dev/null
+++ b/perl/Git/I18N.pm
@@ -0,0 +1,98 @@
+package Git::I18N;
+use 5.008;
+use strict;
+use warnings;
+BEGIN {
+ require Exporter;
+ if ($] < 5.008003) {
+ *import = \&Exporter::import;
+ } else {
+ # Exporter 5.57 which supports this invocation was
+ # released with perl 5.8.3
+ Exporter->import('import');
+ }
+}
+
+our @EXPORT = qw(__);
+our @EXPORT_OK = @EXPORT;
+
+sub __bootstrap_locale_messages {
+ our $TEXTDOMAIN = 'git';
+ our $TEXTDOMAINDIR = $ENV{GIT_TEXTDOMAINDIR} || '++LOCALEDIR++';
+
+ require POSIX;
+ POSIX->import(qw(setlocale));
+ # Non-core prerequisite module
+ require Locale::Messages;
+ Locale::Messages->import(qw(:locale_h :libintl_h));
+
+ setlocale(LC_MESSAGES(), '');
+ setlocale(LC_CTYPE(), '');
+ textdomain($TEXTDOMAIN);
+ bindtextdomain($TEXTDOMAIN => $TEXTDOMAINDIR);
+
+ return;
+}
+
+BEGIN
+{
+ # Used by our test script to see if it should test fallbacks or
+ # not.
+ our $__HAS_LIBRARY = 1;
+
+ local $@;
+ eval {
+ __bootstrap_locale_messages();
+ *__ = \&Locale::Messages::gettext;
+ 1;
+ } or do {
+ # Tell test.pl that we couldn't load the gettext library.
+ $Git::I18N::__HAS_LIBRARY = 0;
+
+ # Just a fall-through no-op
+ *__ = sub ($) { $_[0] };
+ };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Git::I18N - Perl interface to Git's Gettext localizations
+
+=head1 SYNOPSIS
+
+ use Git::I18N;
+
+ print __("Welcome to Git!\n");
+
+ printf __("The following error occured: %s\n"), $error;
+
+=head1 DESCRIPTION
+
+Git's internal Perl interface to gettext via L<Locale::Messages>. If
+L<Locale::Messages> can't be loaded (it's not a core module) we
+provide stub passthrough fallbacks.
+
+This is a distilled interface to gettext, see C<info '(gettext)Perl'>
+for the full interface. This module implements only a small part of
+it.
+
+=head1 FUNCTIONS
+
+=head2 __($)
+
+L<Locale::Messages>'s gettext function if all goes well, otherwise our
+passthrough fallback function.
+
+=head1 AUTHOR
+
+E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avarab@gmail.com>
+
+=head1 COPYRIGHT
+
+Copyright 2010 E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avarab@gmail.com>
+
+=cut
diff --git a/perl/Makefile b/perl/Makefile
index 5e079ad011..3e21766d8f 100644
--- a/perl/Makefile
+++ b/perl/Makefile
@@ -5,6 +5,7 @@ makfile:=perl.mak
PERL_PATH_SQ = $(subst ','\'',$(PERL_PATH))
prefix_SQ = $(subst ','\'',$(prefix))
+localedir_SQ = $(subst ','\'',$(localedir))
ifndef V
QUIET = @
@@ -22,18 +23,26 @@ clean:
ifdef NO_PERL_MAKEMAKER
instdir_SQ = $(subst ','\'',$(prefix)/lib)
$(makfile): ../GIT-CFLAGS Makefile
- echo all: > $@
- echo ' :' >> $@
+ echo all: private-Error.pm Git.pm Git/I18N.pm > $@
+ echo ' mkdir -p blib/lib/Git' >> $@
+ echo ' $(RM) blib/lib/Git.pm; cp Git.pm blib/lib/' >> $@
+ echo ' $(RM) blib/lib/Git/I18N.pm; cp Git/I18N.pm blib/lib/Git/' >> $@
+ echo ' $(RM) blib/lib/Error.pm' >> $@
+ '$(PERL_PATH_SQ)' -MError -e 'exit($$Error::VERSION < 0.15009)' || \
+ echo ' cp private-Error.pm blib/lib/Error.pm' >> $@
echo install: >> $@
- echo ' mkdir -p $(instdir_SQ)' >> $@
- echo ' $(RM) $(instdir_SQ)/Git.pm; cp Git.pm $(instdir_SQ)' >> $@
- echo ' $(RM) $(instdir_SQ)/Error.pm; \
- cp private-Error.pm $(instdir_SQ)/Error.pm' >> $@
+ echo ' mkdir -p "$$(DESTDIR)$(instdir_SQ)"' >> $@
+ echo ' mkdir -p "$$(DESTDIR)$(instdir_SQ)/Git"' >> $@
+ echo ' $(RM) "$$(DESTDIR)$(instdir_SQ)/Git.pm"; cp Git.pm "$$(DESTDIR)$(instdir_SQ)"' >> $@
+ echo ' $(RM) "$$(DESTDIR)$(instdir_SQ)/Git/I18N.pm"; cp Git/I18N.pm "$$(DESTDIR)$(instdir_SQ)/Git"' >> $@
+ echo ' $(RM) "$$(DESTDIR)$(instdir_SQ)/Error.pm"' >> $@
+ '$(PERL_PATH_SQ)' -MError -e 'exit($$Error::VERSION < 0.15009)' || \
+ echo ' cp private-Error.pm "$$(DESTDIR)$(instdir_SQ)/Error.pm"' >> $@
echo instlibdir: >> $@
echo ' echo $(instdir_SQ)' >> $@
else
$(makfile): Makefile.PL ../GIT-CFLAGS
- $(PERL_PATH) $< PREFIX='$(prefix_SQ)'
+ $(PERL_PATH) $< PREFIX='$(prefix_SQ)' INSTALL_BASE='' --localedir='$(localedir_SQ)'
endif
# this is just added comfort for calling make directly in perl dir
diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index 320253eb8e..456d45bf40 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -1,14 +1,33 @@
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
+use Getopt::Long;
+
+# Sanity: die at first unknown option
+Getopt::Long::Configure qw/ pass_through /;
+
+GetOptions("localedir=s" => \my $localedir);
sub MY::postamble {
return <<'MAKE_FRAG';
instlibdir:
@echo '$(INSTALLSITELIB)'
+ifneq (,$(DESTDIR))
+ifeq (0,$(shell expr '$(MM_VERSION)' '>' 6.10))
+$(error ExtUtils::MakeMaker version "$(MM_VERSION)" is older than 6.11 and so \
+ is likely incompatible with the DESTDIR mechanism. Try setting \
+ NO_PERL_MAKEMAKER=1 instead)
+endif
+endif
+
MAKE_FRAG
}
-my %pm = ('Git.pm' => '$(INST_LIBDIR)/Git.pm');
+my %pm = (
+ 'Git.pm' => '$(INST_LIBDIR)/Git.pm',
+ 'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm',
+);
# We come with our own bundled Error.pm. It's not in the set of default
# Perl modules so install it if it's not available on the system yet.
@@ -25,6 +44,7 @@ WriteMakefile(
NAME => 'Git',
VERSION_FROM => 'Git.pm',
PM => \%pm,
+ PM_FILTER => qq[\$(PERL) -pe "s<\\Q++LOCALEDIR++\\E><$localedir>"],
MAKEFILE => 'perl.mak',
INSTALLSITEMAN3DIR => '$(SITEPREFIX)/share/man/man3'
);