summaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Git.pm80
-rw-r--r--perl/Git/I18N.pm98
-rw-r--r--perl/Makefile10
-rw-r--r--perl/Makefile.PL14
4 files changed, 154 insertions, 48 deletions
diff --git a/perl/Git.pm b/perl/Git.pm
index a86ab709c2..497f420178 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -570,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({}, @_);
}
@@ -603,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
@@ -635,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;
}
@@ -699,7 +691,7 @@ 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 an URL or a remote name (if called on a repository instance).
+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
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 a2ffb6402d..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,15 +23,18 @@ clean:
ifdef NO_PERL_MAKEMAKER
instdir_SQ = $(subst ','\'',$(prefix)/lib)
$(makfile): ../GIT-CFLAGS Makefile
- echo all: private-Error.pm Git.pm > $@
- echo ' mkdir -p blib/lib' >> $@
+ 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 "$$(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"' >> $@
@@ -38,7 +42,7 @@ $(makfile): ../GIT-CFLAGS Makefile
echo ' echo $(instdir_SQ)' >> $@
else
$(makfile): Makefile.PL ../GIT-CFLAGS
- $(PERL_PATH) $< PREFIX='$(prefix_SQ)' INSTALL_BASE=''
+ $(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 0b9deca2cc..456d45bf40 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -1,4 +1,12 @@
+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';
@@ -16,7 +24,10 @@ 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.
@@ -33,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'
);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-30 09:52:16 +0000