summaryrefslogtreecommitdiff
path: root/macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm
diff options
context:
space:
mode:
Diffstat (limited to 'macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm')
-rw-r--r--macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm1275
1 files changed, 683 insertions, 592 deletions
diff --git a/macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm b/macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm
index 584bd5d730..98eeabcc57 100644
--- a/macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm
+++ b/macros/texinfo/texinfo/tp/maintain/lib/libintl-perl/lib/Locale/gettext_pp.pm
@@ -1,26 +1,23 @@
#! /bin/false
# vim: set autoindent shiftwidth=4 tabstop=4:
-# $Id: gettext_pp.pm,v 1.1 2011-10-12 23:51:27 pertusus Exp $
# Pure Perl implementation of Uniforum message translation.
-# Copyright (C) 2002-2009 Guido Flohr <guido@imperia.net>,
+# Copyright (C) 2002-2017 Guido Flohr <guido.flohr@cantanea.com>,
# all rights reserved.
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Locale::gettext_pp;
@@ -29,151 +26,154 @@ use strict;
require 5.004;
use vars qw ($__gettext_pp_default_dir
- $__gettext_pp_textdomain
- $__gettext_pp_domain_bindings
- $__gettext_pp_domain_codeset_bindings
- $__gettext_pp_domains
- $__gettext_pp_recoders
- $__gettext_pp_unavailable_dirs
- $__gettext_pp_domain_cache
- $__gettext_pp_alias_cache
- $__gettext_pp_context_glue);
+ $__gettext_pp_textdomain
+ $__gettext_pp_domain_bindings
+ $__gettext_pp_domain_codeset_bindings
+ $__gettext_pp_domains
+ $__gettext_pp_recoders
+ $__gettext_pp_unavailable_dirs
+ $__gettext_pp_domain_cache
+ $__gettext_pp_alias_cache
+ $__gettext_pp_context_glue);
use locale;
+use File::Spec;
+use Locale::Messages;
BEGIN {
- $__gettext_pp_textdomain = 'messages';
- $__gettext_pp_domain_bindings = {};
- $__gettext_pp_domain_codeset_bindings = {};
- $__gettext_pp_domains = {};
- $__gettext_pp_recoders = {};
- $__gettext_pp_unavailable_dirs = {};
- $__gettext_pp_domain_cache = {};
- $__gettext_pp_alias_cache = {};
- # The separator between msgctxt and msgid in a .mo file. */
- $__gettext_pp_context_glue = "\004";
-
- $__gettext_pp_default_dir = '';
-
- for my $dir (qw (/usr/share/locale /usr/local/share/locale)) {
- if (-d $dir) {
- $__gettext_pp_default_dir = $dir;
- last;
- }
- }
+ $__gettext_pp_textdomain = 'messages';
+ $__gettext_pp_domain_bindings = {};
+ $__gettext_pp_domain_codeset_bindings = {};
+ $__gettext_pp_domains = {};
+ $__gettext_pp_recoders = {};
+ $__gettext_pp_unavailable_dirs = {};
+ $__gettext_pp_domain_cache = {};
+ $__gettext_pp_alias_cache = {};
+ # The separator between msgctxt and msgid in a .mo file. */
+ $__gettext_pp_context_glue = "\004";
+
+ $__gettext_pp_default_dir = '';
+
+ for my $dir (qw (/usr/share/locale /usr/local/share/locale)) {
+ if (-d $dir) {
+ $__gettext_pp_default_dir = $dir;
+ last;
+ }
+ }
}
BEGIN {
- require POSIX;
- require Exporter;
- use IO::Handle;
- require Locale::Recode;
-
- local $@;
- my ($has_messages, $five_ok);
-
- $has_messages = eval '&POSIX::LC_MESSAGES';
-
- unless (defined $has_messages && length $has_messages) {
- $five_ok = ! grep {my $x = eval "&POSIX::$_" || 0; $x eq '5';}
- qw (LC_CTYPE
- LC_NUMERIC
- LC_TIME
- LC_COLLATE
- LC_MONETARY
- LC_ALL);
- if ($five_ok) {
- $five_ok = POSIX::setlocale (5, '');
- }
- }
-
- if (defined $has_messages && length $has_messages) {
+ require POSIX;
+ require Exporter;
+ use IO::Handle;
+ require Locale::Recode;
+
+ local $@;
+ my ($has_messages, $five_ok);
+
+ $has_messages = eval '&POSIX::LC_MESSAGES';
+
+ unless (defined $has_messages && length $has_messages) {
+ $five_ok = ! grep {my $x = eval "&POSIX::$_" || 0; $x eq '5';}
+ qw (LC_CTYPE
+ LC_NUMERIC
+ LC_TIME
+ LC_COLLATE
+ LC_MONETARY
+ LC_ALL);
+ if ($five_ok) {
+ $five_ok = POSIX::setlocale (5, '');
+ }
+ }
+
+ if (defined $has_messages && length $has_messages) {
eval <<'EOF';
sub LC_MESSAGES()
{
- local $!; # Do not clobber errno!
-
- return &POSIX::LC_MESSAGES;
+ local $!; # Do not clobber errno!
+
+ return &POSIX::LC_MESSAGES;
}
EOF
- } elsif ($five_ok) {
+ } elsif ($five_ok) {
eval <<'EOF';
sub LC_MESSAGES()
{
- local $!; # Do not clobber errno!
+ local $!; # Do not clobber errno!
- # Hack: POSIX.pm deems LC_MESSAGES an invalid macro until
- # Perl 5.8.0. However, on LC_MESSAGES should be 5 ...
- return 5;
+ # Hack: POSIX.pm deems LC_MESSAGES an invalid macro until
+ # Perl 5.8.0. However, on LC_MESSAGES should be 5 ...
+ return 5;
}
EOF
- } else {
+ } else {
eval <<'EOF';
sub LC_MESSAGES()
{
- local $!; # Do not clobber errno!
+ local $!; # Do not clobber errno!
- # This fallback value is widely used,
- # when LC_MESSAGES is not available.
- return 1729;
+ # This fallback value is widely used,
+ # when LC_MESSAGES is not available.
+ return 1729;
}
EOF
- }
+ }
}
use vars qw (%EXPORT_TAGS @EXPORT_OK @ISA $VERSION);
%EXPORT_TAGS = (locale_h => [ qw (
- gettext
- dgettext
- dcgettext
- ngettext
- dngettext
- dcngettext
- pgettext
- dpgettext
- dcpgettext
- npgettext
- dnpgettext
- dcnpgettext
- textdomain
- bindtextdomain
- bind_textdomain_codeset
- )
- ],
- libintl_h => [ qw (LC_CTYPE
- LC_NUMERIC
- LC_TIME
- LC_COLLATE
- LC_MONETARY
- LC_MESSAGES
- LC_ALL)
- ],
- );
+ gettext
+ dgettext
+ dcgettext
+ ngettext
+ dngettext
+ dcngettext
+ pgettext
+ dpgettext
+ dcpgettext
+ npgettext
+ dnpgettext
+ dcnpgettext
+ textdomain
+ bindtextdomain
+ bind_textdomain_codeset
+ )
+ ],
+ libintl_h => [ qw (LC_CTYPE
+ LC_NUMERIC
+ LC_TIME
+ LC_COLLATE
+ LC_MONETARY
+ LC_MESSAGES
+ LC_ALL)
+ ],
+ );
@EXPORT_OK = qw (gettext
- dgettext
- dcgettext
- ngettext
- dngettext
- dcngettext
- pgettext
- dpgettext
- dcpgettext
- npgettext
- dnpgettext
- dcnpgettext
- textdomain
- bindtextdomain
- bind_textdomain_codeset
+ dgettext
+ dcgettext
+ ngettext
+ dngettext
+ dcngettext
+ pgettext
+ dpgettext
+ dcpgettext
+ npgettext
+ dnpgettext
+ dcnpgettext
+ textdomain
+ bindtextdomain
+ bind_textdomain_codeset
nl_putenv
- LC_CTYPE
- LC_NUMERIC
- LC_TIME
- LC_COLLATE
- LC_MONETARY
- LC_MESSAGES
- LC_ALL);
+ setlocale
+ LC_CTYPE
+ LC_NUMERIC
+ LC_TIME
+ LC_COLLATE
+ LC_MONETARY
+ LC_MESSAGES
+ LC_ALL);
@ISA = qw (Exporter);
my $has_nl_langinfo;
@@ -181,264 +181,275 @@ my $has_nl_langinfo;
sub __load_catalog;
sub __load_domain;
sub __locale_category;
+sub __untaint_plural_header;
+sub __compile_plural_function;
sub LC_NUMERIC()
{
- &POSIX::LC_NUMERIC;
+ &POSIX::LC_NUMERIC;
}
sub LC_CTYPE()
{
- &POSIX::LC_CTYPE;
+ &POSIX::LC_CTYPE;
}
sub LC_TIME()
{
- &POSIX::LC_TIME;
+ &POSIX::LC_TIME;
}
sub LC_COLLATE()
{
- &POSIX::LC_COLLATE;
+ &POSIX::LC_COLLATE;
}
sub LC_MONETARY()
{
- &POSIX::LC_MONETARY;
+ &POSIX::LC_MONETARY;
}
sub LC_ALL()
{
- &POSIX::LC_ALL;
+ &POSIX::LC_ALL;
}
sub textdomain(;$)
{
- my $new_domain = shift;
-
- $__gettext_pp_textdomain = $new_domain if defined $new_domain &&
- length $new_domain;
-
- return $__gettext_pp_textdomain;
+ my $new_domain = shift;
+
+ $__gettext_pp_textdomain = $new_domain if defined $new_domain &&
+ length $new_domain;
+
+ return $__gettext_pp_textdomain;
}
sub bindtextdomain($;$)
{
- my ($domain, $directory) = @_;
-
- my $retval;
- if (defined $domain && length $domain) {
- if (defined $directory && length $directory) {
- $retval = $__gettext_pp_domain_bindings->{$domain}
- = $directory;
- } elsif (exists $__gettext_pp_domain_bindings->{$domain}) {
- $retval = $__gettext_pp_domain_bindings->{$domain};
- } else {
- $retval = $__gettext_pp_default_dir;
- }
- $retval = '/usr/share/locale' unless defined $retval &&
- length $retval;
- return $retval;
- } else {
- return;
- }
+ my ($domain, $directory) = @_;
+
+ my $retval;
+ if (defined $domain && length $domain) {
+ if (defined $directory && length $directory) {
+ $retval = $__gettext_pp_domain_bindings->{$domain}
+ = $directory;
+ } elsif (exists $__gettext_pp_domain_bindings->{$domain}) {
+ $retval = $__gettext_pp_domain_bindings->{$domain};
+ } else {
+ $retval = $__gettext_pp_default_dir;
+ }
+ $retval = '/usr/share/locale' unless defined $retval &&
+ length $retval;
+ return $retval;
+ } else {
+ return;
+ }
}
sub bind_textdomain_codeset($;$)
{
- my ($domain, $codeset) = @_;
-
- if (defined $domain && length $domain) {
- if (defined $codeset && length $codeset) {
- return $__gettext_pp_domain_codeset_bindings->{$domain} = $codeset;
- } elsif (exists $__gettext_pp_domain_codeset_bindings->{$domain}) {
- return $__gettext_pp_domain_codeset_bindings->{$domain};
- }
- }
-
- return;
+ my ($domain, $codeset) = @_;
+
+ if (defined $domain && length $domain) {
+ if (defined $codeset && length $codeset) {
+ return $__gettext_pp_domain_codeset_bindings->{$domain} = $codeset;
+ } elsif (exists $__gettext_pp_domain_codeset_bindings->{$domain}) {
+ return $__gettext_pp_domain_codeset_bindings->{$domain};
+ }
+ }
+
+ return;
}
sub gettext($)
{
- my ($msgid) = @_;
+ my ($msgid) = @_;
- return dcnpgettext ('', undef, $msgid, undef, undef, undef);
+ return dcnpgettext ('', undef, $msgid, undef, undef, undef);
}
sub dgettext($$)
{
- my ($domainname, $msgid) = @_;
+ my ($domainname, $msgid) = @_;
- return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
+ return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
}
sub dcgettext($$$)
{
- my ($domainname, $msgid, $category) = @_;
+ my ($domainname, $msgid, $category) = @_;
- return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
+ return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
}
sub ngettext($$$)
{
- my ($msgid, $msgid_plural, $n) = @_;
+ my ($msgid, $msgid_plural, $n) = @_;
- return dcnpgettext ('', undef, $msgid, $msgid_plural, $n, undef);
+ return dcnpgettext ('', undef, $msgid, $msgid_plural, $n, undef);
}
sub dngettext($$$$)
{
- my ($domainname, $msgid, $msgid_plural, $n) = @_;
+ my ($domainname, $msgid, $msgid_plural, $n) = @_;
- return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, undef);
+ return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, undef);
}
sub dcngettext($$$$$)
{
- my ($domainname, $msgid, $msgid_plural, $n, $category) = @_;
+ my ($domainname, $msgid, $msgid_plural, $n, $category) = @_;
- return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, , $category);
+ return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, , $category);
}
sub pgettext($$)
{
- my ($msgctxt, $msgid) = @_;
+ my ($msgctxt, $msgid) = @_;
- return dcnpgettext ('', $msgctxt, $msgid, undef, undef, undef);
+ return dcnpgettext ('', $msgctxt, $msgid, undef, undef, undef);
}
sub dpgettext($$$)
{
- my ($domainname, $msgctxt, $msgid) = @_;
+ my ($domainname, $msgctxt, $msgid) = @_;
- return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
+ return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
}
sub dcpgettext($$$$)
{
- my ($domainname, $msgctxt, $msgid, $category) = @_;
+ my ($domainname, $msgctxt, $msgid, $category) = @_;
- return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
+ return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
}
sub npgettext($$$$)
{
- my ($msgctxt, $msgid, $msgid_plural, $n) = @_;
+ my ($msgctxt, $msgid, $msgid_plural, $n) = @_;
- return dcnpgettext ('', $msgctxt, $msgid, $msgid_plural, $n, undef);
+ return dcnpgettext ('', $msgctxt, $msgid, $msgid_plural, $n, undef);
}
sub dnpgettext($$$$$)
{
- my ($domainname, $msgctxt, $msgid, $msgid_plural, $n) = @_;
+ my ($domainname, $msgctxt, $msgid, $msgid_plural, $n) = @_;
- return dcnpgettext ($domainname, $msgctxt, $msgid, $msgid_plural, $n, undef);
+ return dcnpgettext ($domainname, $msgctxt, $msgid, $msgid_plural, $n, undef);
}
-sub dcnpgettext($$$$$$)
-{
- my ($domainname, $msgctxt, $msgid, $msgid_plural, $n, $category) = @_;
-
- return unless defined $msgid;
-
- my $plural = defined $msgid_plural;
- my $msg_ctxt_id = defined $msgctxt ? join($__gettext_pp_context_glue, ($msgctxt, $msgid)) : $msgid;
-
- local $!; # Do not clobber errno!
-
- # This is also done in __load_domain but we need a proper value.
- $domainname = $__gettext_pp_textdomain
- unless defined $domainname && length $domainname;
-
- # Category is always LC_MESSAGES (other categories are ignored).
- my $category_name = 'LC_MESSAGES';
- $category = LC_MESSAGES;
-
- my $domains = __load_domain ($domainname, $category, $category_name);
-
- my @trans = ();
- my $domain;
- my $found;
- foreach my $this_domain (@$domains) {
- if ($this_domain && defined $this_domain->{messages}->{$msg_ctxt_id}) {
- @trans = @{$this_domain->{messages}->{$msg_ctxt_id}};
- shift @trans;
- $domain = $this_domain;
- $found = 1;
- last;
- }
- }
- @trans = ($msgid, $msgid_plural) unless @trans;
-
- my $trans = $trans[0];
- if ($plural) {
- if ($domain) {
- my $nplurals = 0;
- ($nplurals, $plural) = &{$domain->{plural_func}} ($n);
- $plural = 0 unless defined $plural;
- $nplurals = 0 unless defined $nplurals;
- $plural = 0 if $nplurals <= $plural;
- } else {
- $plural = $n != 1 || 0;
- }
-
- $trans = $trans[$plural] if defined $trans[$plural];
- }
-
- if ($found && defined $domain->{po_header}->{charset}) {
- my $input_codeset = $domain->{po_header}->{charset};
- # Convert into output charset.
- my $output_codeset = $__gettext_pp_domain_codeset_bindings->{$domainname};
-
- $output_codeset = $ENV{OUTPUT_CHARSET} unless defined $output_codeset;
- $output_codeset = __get_codeset ($category, $category_name,
- $domain->{locale_id})
- unless defined $output_codeset;
-
- unless (defined $output_codeset) {
- # Still no point.
- my $lc_ctype = __locale_category (POSIX::LC_CTYPE(),
- 'LC_CTYPE');
- $output_codeset = $1
- if $lc_ctype =~ /^[a-z]{2}(?:_[A-Z]{2})?\.([^@]+)/;
- }
-
- # No point. :-(
- $output_codeset = $domain->{po_header}->{charset}
- unless defined $output_codeset;
-
- if (exists $__gettext_pp_domain_cache->{$output_codeset}) {
- $output_codeset = $__gettext_pp_domain_cache->{$output_codeset};
- } else {
- $output_codeset = 'utf-8' if lc $output_codeset eq 'utf8';
- $output_codeset =
- $__gettext_pp_domain_cache->{$output_codeset} =
- Locale::Recode->resolveAlias ($output_codeset);
- }
-
- if (defined $output_codeset &&
- $output_codeset ne $domain->{po_header}->{charset}) {
- # We have to convert.
- my $recoder;
-
- if (exists
- $__gettext_pp_recoders->{$input_codeset}->{$output_codeset}) {
- $recoder = $__gettext_pp_recoders->{$input_codeset}->{$output_codeset};
- } else {
- $recoder =
- $__gettext_pp_recoders->{$input_codeset}->{$output_codeset} =
- Locale::Recode->new (from => $input_codeset,
- to => $output_codeset,
- );
- }
-
- $recoder->recode ($trans);
- }
- }
-
- return $trans;
+# This is the actual implementation of dncpgettext. It is also used by the
+# corresponding function in Locale::gettext_dumb.
+sub _dcnpgettext_impl {
+ my ($domainname, $msgctxt, $msgid, $msgid_plural, $n, $category,
+ $locale) = @_;
+
+ return unless defined $msgid;
+
+ my $plural = defined $msgid_plural;
+ Locale::Messages::turn_utf_8_off($msgid);
+ Locale::Messages::turn_utf_8_off($msgctxt) if defined $msgctxt;
+ my $msg_ctxt_id = defined $msgctxt ? join($__gettext_pp_context_glue, ($msgctxt, $msgid)) : $msgid;
+
+ local $!; # Do not clobber errno!
+
+ # This is also done in __load_domain but we need a proper value.
+ $domainname = $__gettext_pp_textdomain
+ unless defined $domainname && length $domainname;
+
+ # Category is always LC_MESSAGES (other categories are ignored).
+ my $category_name = 'LC_MESSAGES';
+ $category = LC_MESSAGES;
+
+ my $domains = __load_domain ($domainname, $category, $category_name,
+ $locale);
+
+ my @trans = ();
+ my $domain;
+ my $found;
+ foreach my $this_domain (@$domains) {
+ if ($this_domain && defined $this_domain->{messages}->{$msg_ctxt_id}) {
+ @trans = @{$this_domain->{messages}->{$msg_ctxt_id}};
+ shift @trans;
+ $domain = $this_domain;
+ $found = 1;
+ last;
+ }
+ }
+ @trans = ($msgid, $msgid_plural) unless @trans;
+
+ my $trans = $trans[0];
+ if ($plural) {
+ if ($domain) {
+ my $nplurals = 0;
+ ($nplurals, $plural) = &{$domain->{plural_func}} ($n);
+ $plural = 0 unless defined $plural;
+ $nplurals = 0 unless defined $nplurals;
+ $plural = 0 if $nplurals <= $plural;
+ } else {
+ $plural = $n != 1 || 0;
+ }
+
+ $trans = $trans[$plural] if defined $trans[$plural];
+ }
+
+ if ($found && defined $domain->{po_header}->{charset}) {
+ my $input_codeset = $domain->{po_header}->{charset};
+ # Convert into output charset.
+ my $output_codeset = $__gettext_pp_domain_codeset_bindings->{$domainname};
+
+ $output_codeset = $ENV{OUTPUT_CHARSET} unless defined $output_codeset;
+ $output_codeset = __get_codeset ($category, $category_name,
+ $domain->{locale_id})
+ unless defined $output_codeset;
+
+ unless (defined $output_codeset) {
+ # Still no point.
+ my $lc_ctype = __locale_category (POSIX::LC_CTYPE(),
+ 'LC_CTYPE');
+ $output_codeset = $1
+ if $lc_ctype =~ /^[a-z]{2}(?:_[A-Z]{2})?\.([^@]+)/;
+ }
+
+ # No point. :-(
+ $output_codeset = $domain->{po_header}->{charset}
+ unless defined $output_codeset;
+
+ if (exists $__gettext_pp_domain_cache->{$output_codeset}) {
+ $output_codeset = $__gettext_pp_domain_cache->{$output_codeset};
+ } else {
+ $output_codeset = 'utf-8' if lc $output_codeset eq 'utf8';
+ $output_codeset =
+ $__gettext_pp_domain_cache->{$output_codeset} =
+ Locale::Recode->resolveAlias ($output_codeset);
+ }
+
+ if (defined $output_codeset &&
+ $output_codeset ne $domain->{po_header}->{charset}) {
+ # We have to convert.
+ my $recoder;
+
+ if (exists
+ $__gettext_pp_recoders->{$input_codeset}->{$output_codeset}) {
+ $recoder = $__gettext_pp_recoders->{$input_codeset}->{$output_codeset};
+ } else {
+ $recoder =
+ $__gettext_pp_recoders->{$input_codeset}->{$output_codeset} =
+ Locale::Recode->new (from => $input_codeset,
+ to => $output_codeset,
+ );
+ }
+
+ $recoder->recode ($trans);
+ }
+ }
+
+ return $trans;
+}
+
+sub dcnpgettext ($$$$$$) {
+ return &_dcnpgettext_impl;
}
sub nl_putenv ($)
@@ -471,311 +482,389 @@ sub nl_putenv ($)
return 1;
}
-sub __load_domain
-{
- my ($domainname, $category, $category_name) = @_;
-
- $domainname = $__gettext_pp_textdomain
- unless defined $domainname && length $domainname;
-
- my $dir = bindtextdomain ($domainname, '');
- $dir = $__gettext_pp_default_dir unless defined $dir && length $dir;
- return [] unless defined $dir && length $dir;
-
- my @locales;
- my $cache_key;
-
- if (defined $ENV{LANGUAGE} && length $ENV{LANGUAGE}) {
- @locales = split /:/, $ENV{LANGUAGE};
- $cache_key = $ENV{LANGUAGE};
- } else {
- @locales = $cache_key = __locale_category ($category, $category_name);
- }
-
- # Have we looked that one up already?
- my $domains = $__gettext_pp_domain_cache->{$dir}->{$cache_key}->{$category_name}->{$domainname};
-
- if (@locales && !defined $domains) {
- my @dirs = ($dir);
- my @tries = (@locales);
- my %locale_lookup = map { $_ => $_ } @tries;
-
- foreach my $locale (@locales) {
- if ($locale =~ /^([a-z][a-z])
- (?:(_[A-Z][A-Z])?
- (\.[-_A-Za-z0-9]+)?
- )?
- (\@[-_A-Za-z0-9]+)?$/x) {
-
- if (defined $3) {
- defined $2 ?
- push @tries, $1 . $2 . $3 : push @tries, $1 . $3;
- }
- if (defined $2) {
- push @tries, $1 . $2;
- $locale_lookup{$1 . $2} = $locale;
- }
- if (defined $1) {
- push @tries, $1 if defined $1;
- $locale_lookup{$1} = $locale;
- }
- }
- }
-
- push @dirs, $__gettext_pp_default_dir
- if $__gettext_pp_default_dir && $dir ne $__gettext_pp_default_dir;
-
- my %seen = ();
- foreach my $basedir (@dirs) {
- foreach my $try (@tries) {
- my $fulldir = "$basedir/$try/$category_name";
-
- next if $seen{$fulldir}++;
-
- # If the cache for unavailable directories is removed,
- # the three lines below should be replaced by:
- # 'next unless -d $fulldir;'
- next if $__gettext_pp_unavailable_dirs->{$fulldir};
- ++$__gettext_pp_unavailable_dirs->{$fulldir} and next
- unless -d $fulldir;
-
- my $domain = __load_catalog $fulldir, $domainname;
- next unless $domain;
-
- unless (defined $domain->{po_header}->{charset} &&
- length $domain->{po_header}->{charset} &&
- $try =~ /^(?:[a-z][a-z])
- (?:(?:_[A-Z][A-Z])?
- (\.[-_A-Za-z0-9]+)?
- )?
- (?:\@[-_A-Za-z0-9]+)?$/x) {
- $domain->{po_header}->{charset} = $1;
- }
-
- if (defined $domain->{po_header}->{charset}) {
- $domain->{po_header}->{charset} =
- Locale::Recode->resolveAlias ($domain->{po_header}->{charset});
- }
- $domain->{locale_id} = $locale_lookup{$try};
- push @$domains, $domain;
- }
- }
- $__gettext_pp_domain_cache->{$dir}->{$cache_key}->{$category_name}->{$domainname} = $domains;
- }
-
- $domains = [] unless defined $domains;
- return $domains;
+sub setlocale($;$) {
+ require POSIX;
+ &POSIX::setlocale;
+}
+
+sub __selected_locales {
+ my ($locale, $category, $category_name) = @_;
+
+ my @locales;
+ my $cache_key;
+
+ if (defined $ENV{LANGUAGE} && length $ENV{LANGUAGE}) {
+ @locales = split /:/, $ENV{LANGUAGE};
+ $cache_key = $ENV{LANGUAGE};
+ } elsif (!defined $locale) {
+ # The system does not have LC_MESSAGES. Guess the value.
+ @locales = $cache_key = __locale_category ($category,
+ $category_name);
+ } else {
+ @locales = $cache_key = $locale;
+ }
+
+ return $cache_key, @locales;
+}
+
+sub __extend_locales {
+ my (@locales) = @_;
+
+ my @tries = @locales;
+ my %locale_lookup = map { $_ => $_ } @tries;
+
+ foreach my $locale (@locales) {
+ if ($locale =~ /^([a-z][a-z])
+ (?:(_[A-Z][A-Z])?
+ (\.[-_A-Za-z0-9]+)?
+ )?
+ (\@[-_A-Za-z0-9]+)?$/x) {
+
+ if (defined $3) {
+ defined $2 ?
+ push @tries, $1 . $2 . $3 : push @tries, $1 . $3;
+ $locale_lookup{$tries[-1]} = $locale;
+ }
+ if (defined $2) {
+ push @tries, $1 . $2;
+ $locale_lookup{$1 . $2} = $locale;
+ }
+ if (defined $1) {
+ push @tries, $1 if defined $1;
+ $locale_lookup{$1} = $locale;
+ }
+ }
+ }
+
+ return \@tries, \%locale_lookup;
+}
+
+sub __load_domain {
+ my ($domainname, $category, $category_name, $locale) = @_;
+
+ # If no locale was selected for the requested locale category,
+ # l10n is disabled completely. This matches the behavior of GNU
+ # gettext.
+ if ($category != LC_MESSAGES) {
+ # Not supported.
+ return [];
+ }
+
+ if (!defined $locale && $category != 1729) {
+ $locale = POSIX::setlocale ($category);
+ if (!defined $locale || 'C' eq $locale || 'POSIX' eq $locale) {
+ return [];
+ }
+ }
+
+ $domainname = $__gettext_pp_textdomain
+ unless defined $domainname && length $domainname;
+
+ my $dir = bindtextdomain ($domainname, '');
+ $dir = $__gettext_pp_default_dir unless defined $dir && length $dir;
+
+ return [] unless defined $dir && length $dir;
+
+ my ($cache_key, @locales) = __selected_locales $locale, $category, $category_name;
+
+ # Have we looked that one up already?
+ my $domains = $__gettext_pp_domain_cache->{$dir}->{$cache_key}->{$category_name}->{$domainname};
+ return $domains if defined $domains;
+ return [] unless @locales;
+
+ my @dirs = ($dir);
+ my ($tries, $lookup) = __extend_locales @locales;
+
+ push @dirs, $__gettext_pp_default_dir
+ if $__gettext_pp_default_dir && $dir ne $__gettext_pp_default_dir;
+
+ my %seen;
+ my %loaded;
+ foreach my $basedir (@dirs) {
+ foreach my $try (@$tries) {
+ # If we had already found a catalog for "xy_XY", do not try it
+ # again.
+ next if $loaded{$try};
+
+ my $fulldir = File::Spec->catfile($basedir, $try, $category_name);
+ next if $seen{$fulldir}++;
+
+ # If the cache for unavailable directories is removed,
+ # the three lines below should be replaced by:
+ # 'next unless -d $fulldir;'
+ next if $__gettext_pp_unavailable_dirs->{$fulldir};
+ ++$__gettext_pp_unavailable_dirs->{$fulldir} and next
+ unless -d $fulldir;
+ my $filename = File::Spec->catfile($fulldir, "$domainname.mo");
+ my $domain = __load_catalog $filename, $try;
+ next unless $domain;
+
+ $loaded{$try} = 1;
+
+ $domain->{locale_id} = $lookup->{$try};
+ push @$domains, $domain;
+ }
+ }
+
+ $domains = [] unless defined $domains;
+
+ $__gettext_pp_domain_cache->{$dir}
+ ->{$cache_key}
+ ->{$category_name}
+ ->{$domainname} = $domains;
+
+ return $domains;
}
sub __load_catalog
{
- my ($directory, $domainname) = @_;
-
- my $filename = "$directory/$domainname.mo";
-
- # Alternatively we could check the filename for evil characters ...
- # (Important for CGIs).
- return unless -f $filename && -r $filename;
-
- local $/;
- local *HANDLE;
-
- open HANDLE, "<$filename"
- or return;
- binmode HANDLE;
- my $raw = <HANDLE>;
- close HANDLE;
-
- # Corrupted?
- return if ! defined $raw || length $raw < 28;
-
- my $filesize = length $raw;
-
- # Read the magic number in order to determine the byte order.
- my $domain = {};
- my $unpack = 'N';
- $domain->{potter} = unpack $unpack, substr $raw, 0, 4;
-
- if ($domain->{potter} == 0xde120495) {
- $unpack = 'V';
- } elsif ($domain->{potter} != 0x950412de) {
- return;
- }
- my $domain_unpack = $unpack x 6;
-
- my ($revision, $num_strings, $msgids_off, $msgstrs_off,
- $hash_size, $hash_off) =
- unpack (($unpack x 6), substr $raw, 4, 24);
-
- return unless $revision == 0; # Invalid revision number.
-
- $domain->{revision} = $revision;
- $domain->{num_strings} = $num_strings;
- $domain->{msgids_off} = $msgids_off;
- $domain->{msgstrs_off} = $msgstrs_off;
- $domain->{hash_size} = $hash_size;
- $domain->{hash_off} = $hash_off;
-
- return if $msgids_off + 4 * $num_strings > $filesize;
- return if $msgstrs_off + 4 * $num_strings > $filesize;
-
- my @orig_tab = unpack (($unpack x (2 * $num_strings)),
- substr $raw, $msgids_off, 8 * $num_strings);
- my @trans_tab = unpack (($unpack x (2 * $num_strings)),
- substr $raw, $msgstrs_off, 8 * $num_strings);
-
- my $messages = {};
-
- for (my $count = 0; $count < 2 * $num_strings; $count += 2) {
- my $orig_length = $orig_tab[$count];
- my $orig_offset = $orig_tab[$count + 1];
- my $trans_length = $trans_tab[$count];
- my $trans_offset = $trans_tab[$count + 1];
-
- return if $orig_offset + $orig_length > $filesize;
- return if $trans_offset + $trans_length > $filesize;
-
- my @origs = split /\000/, substr $raw, $orig_offset, $orig_length;
- my @trans = split /\000/, substr $raw, $trans_offset, $trans_length;
-
- # The singular is the key, the plural plus all translations is the
- # value.
- my $msgid = $origs[0];
- $msgid = '' unless defined $msgid && length $msgid;
- my $msgstr = [ $origs[1], @trans ];
- $messages->{$msgid} = $msgstr;
- }
-
- $domain->{messages} = $messages;
-
- # Try to find po header information.
- my $po_header = {};
- my $null_entry = $messages->{''}->[1];
- if ($null_entry) {
- my @lines = split /\n/, $null_entry;
- foreach my $line (@lines) {
- my ($key, $value) = split /:/, $line, 2;
- $key =~ s/-/_/g;
- $po_header->{lc $key} = $value;
- }
- }
- $domain->{po_header} = $po_header;
-
- if (exists $domain->{po_header}->{content_type}) {
- my $content_type = $domain->{po_header}->{content_type};
- if ($content_type =~ s/.*=//) {
- $domain->{po_header}->{charset} = $content_type;
- }
- }
-
- my $code = $domain->{po_header}->{plural_forms} || '';
-
- # Whitespace, locale-independent.
- my $s = '[ \t\r\n\013\014]';
-
- # Untaint the plural header.
- # Keep line breaks as is (Perl 5_005 compatibility).
- if ($code =~ m{^($s*
- nplurals$s*=$s*[0-9]+
- $s*;$s*
- plural$s*=$s*(?:$s|[-\?\|\&=!<>+*/\%:;a-zA-Z0-9_\(\)])+
- )}xms) {
- $domain->{po_header}->{plural_forms} = $1;
- } else {
- $domain->{po_header}->{plural_forms} = '';
- }
-
- # Determine plural rules.
- # The leading and trailing space is necessary to be able to match
- # against word boundaries.
- my $plural_func;
-
- if ($domain->{po_header}->{plural_forms}) {
- my $code = ' ' . $domain->{po_header}->{plural_forms} . ' ';
- $code =~
- s/([^_a-zA-Z0-9]|\A)([_a-z][_A-Za-z0-9]*)([^_a-zA-Z0-9])/$1\$$2$3/g;
-
- $code = "sub { my \$n = shift;
- my (\$plural, \$nplurals);
- $code;
- return (\$nplurals, \$plural ? \$plural : 0); }";
-
- # Now try to evaluate the code. There is no need to run the code in
- # a Safe compartment. The above substitutions should have destroyed
- # all evil code. Corrections are welcome!
- $plural_func = eval $code;
- undef $plural_func if $@;
- }
-
- # Default is Germanic plural (which is incorrect for French).
- $plural_func = eval "sub { (2, 1 != shift || 0) }" unless $plural_func;
-
- $domain->{plural_func} = $plural_func;
-
- return $domain;
+ my ($filename, $locale) = @_;
+
+ # Alternatively we could check the filename for evil characters ...
+ # (Important for CGIs).
+ return unless -f $filename && -r $filename;
+
+ local $/;
+ local *HANDLE;
+
+ open HANDLE, "<$filename"
+ or return;
+ binmode HANDLE;
+ my $raw = <HANDLE>;
+ close HANDLE;
+
+ # Corrupted?
+ return if ! defined $raw || length $raw < 28;
+
+ my $filesize = length $raw;
+
+ # Read the magic number in order to determine the byte order.
+ my $domain = {
+ filename => $filename
+ };
+ my $unpack = 'N';
+ $domain->{magic} = unpack $unpack, substr $raw, 0, 4;
+
+ if ($domain->{magic} == 0xde120495) {
+ $unpack = 'V';
+ } elsif ($domain->{magic} != 0x950412de) {
+ return;
+ }
+ my $domain_unpack = $unpack x 6;
+
+ my ($revision, $num_strings, $msgids_off, $msgstrs_off,
+ $hash_size, $hash_off) =
+ unpack (($unpack x 6), substr $raw, 4, 24);
+
+ my $major = $revision >> 16;
+ return if $major != 0; # Invalid revision number.
+
+ $domain->{revision} = $revision;
+ $domain->{num_strings} = $num_strings;
+ $domain->{msgids_off} = $msgids_off;
+ $domain->{msgstrs_off} = $msgstrs_off;
+ $domain->{hash_size} = $hash_size;
+ $domain->{hash_off} = $hash_off;
+
+ return if $msgids_off + 4 * $num_strings > $filesize;
+ return if $msgstrs_off + 4 * $num_strings > $filesize;
+
+ my @orig_tab = unpack (($unpack x (2 * $num_strings)),
+ substr $raw, $msgids_off, 8 * $num_strings);
+ my @trans_tab = unpack (($unpack x (2 * $num_strings)),
+ substr $raw, $msgstrs_off, 8 * $num_strings);
+
+ my $messages = {};
+
+ for (my $count = 0; $count < 2 * $num_strings; $count += 2) {
+ my $orig_length = $orig_tab[$count];
+ my $orig_offset = $orig_tab[$count + 1];
+ my $trans_length = $trans_tab[$count];
+ my $trans_offset = $trans_tab[$count + 1];
+
+ return if $orig_offset + $orig_length > $filesize;
+ return if $trans_offset + $trans_length > $filesize;
+
+ my @origs = split /\000/, substr $raw, $orig_offset, $orig_length;
+ my @trans = split /\000/, substr $raw, $trans_offset, $trans_length;
+
+ # The singular is the key, the plural plus all translations is the
+ # value.
+ my $msgid = $origs[0];
+ $msgid = '' unless defined $msgid && length $msgid;
+ my $msgstr = [ $origs[1], @trans ];
+ $messages->{$msgid} = $msgstr;
+ }
+
+ $domain->{messages} = $messages;
+
+ # Try to find po header information.
+ my $po_header = {};
+ my $null_entry = $messages->{''}->[1];
+ if ($null_entry) {
+ my @lines = split /\n/, $null_entry;
+ foreach my $line (@lines) {
+ my ($key, $value) = split /:/, $line, 2;
+ $key =~ s/-/_/g;
+ $po_header->{lc $key} = $value;
+ }
+ }
+ $domain->{po_header} = $po_header;
+
+ if (exists $domain->{po_header}->{content_type}) {
+ my $content_type = $domain->{po_header}->{content_type};
+ if ($content_type =~ s/.*=//) {
+ $domain->{po_header}->{charset} = $content_type;
+ }
+ }
+
+ my $code = $domain->{po_header}->{plural_forms} || '';
+
+ # Whitespace, locale-independent.
+ my $s = '[ \011-\015]';
+
+ # Untaint the plural header.
+ # Keep line breaks as is (Perl 5_005 compatibility).
+ $code = $domain->{po_header}->{plural_forms}
+ = __untaint_plural_header $code;
+
+ $domain->{plural_func} = __compile_plural_function $code;
+
+ unless (defined $domain->{po_header}->{charset}
+ && length $domain->{po_header}->{charset}
+ && $locale =~ /^(?:[a-z][a-z])
+ (?:(?:_[A-Z][A-Z])?
+ (\.[-_A-Za-z0-9]+)?
+ )?
+ (?:\@[-_A-Za-z0-9]+)?$/x) {
+ $domain->{po_header}->{charset} = $1;
+ }
+
+ if (defined $domain->{po_header}->{charset}) {
+ $domain->{po_header}->{charset} =
+ Locale::Recode->resolveAlias ($domain->{po_header}->{charset});
+ }
+
+ return $domain;
}
sub __locale_category
{
- my ($category, $category_name) = @_;
-
- local $@;
- my $value = eval {POSIX::setlocale ($category)};
-
- # We support only XPG syntax, i. e.
- # language[_territory[.codeset]][@modifier].
- undef $value unless (defined $value &&
- length $value &&
- $value =~ /^[a-z][a-z]
- (?:_[A-Z][A-Z]
- (?:\.[-_A-Za-z0-9]+)?
- )?
- (?:\@[-_A-Za-z0-9]+)?$/x);
-
- unless ($value) {
- $value = $ENV{LC_ALL};
- $value = $ENV{$category_name} unless defined $value && length $value;
- $value = $ENV{LANG} unless defined $value && length $value;
- return 'C' unless defined $value && length $value;
- }
-
- return $value if $value ne 'C' && $value ne 'POSIX';
+ my ($category, $category_name) = @_;
+
+ local $@;
+ my $value = eval {POSIX::setlocale ($category)};
+
+ # We support only XPG syntax, i. e.
+ # language[_territory[.codeset]][@modifier].
+ undef $value unless (defined $value &&
+ length $value &&
+ $value =~ /^[a-z][a-z]
+ (?:_[A-Z][A-Z]
+ (?:\.[-_A-Za-z0-9]+)?
+ )?
+ (?:\@[-_A-Za-z0-9]+)?$/x);
+
+ unless ($value) {
+ $value = $ENV{LC_ALL};
+ $value = $ENV{$category_name} unless defined $value && length $value;
+ $value = $ENV{LANG} unless defined $value && length $value;
+ return 'C' unless defined $value && length $value;
+ }
+
+ return $value if $value ne 'C' && $value ne 'POSIX';
}
sub __get_codeset
{
- my ($category, $category_name, $locale_id) = @_;
-
- local $@;
- unless (defined $has_nl_langinfo) {
- eval {
- require I18N::Langinfo;
- };
- $has_nl_langinfo = !$@;
- }
-
- if ($has_nl_langinfo) {
- # Try to set the locale via the specified id.
- my $saved_locale = eval { POSIX::setlocale (LC_ALL) };
- my $saved_lc_all = $ENV{LC_ALL};
-
- # Now try to set the locale via the environment. There is no
- # point in calling the langinfo routines if this fails.
- $ENV{LC_ALL} = $locale_id;
- my $codeset;
- my $lc_all = eval { POSIX::setlocale (LC_ALL, $locale_id); };
- $codeset = I18N::Langinfo::langinfo (I18N::Langinfo::CODESET())
- if defined $lc_all;
-
- if ($saved_locale) {
- eval { POSIX::setlocale (LC_ALL, $saved_locale); }
- }
- return $codeset;
- }
-
- return;
+ my ($category, $category_name, $locale_id) = @_;
+
+ local $@;
+ unless (defined $has_nl_langinfo) {
+ eval {
+ require I18N::Langinfo;
+ };
+ $has_nl_langinfo = !$@;
+ }
+
+ if ($has_nl_langinfo) {
+ # Try to set the locale via the specified id.
+ my $saved_locale = eval { POSIX::setlocale (LC_ALL) };
+ my $had_lc_all = exists $ENV{LC_ALL};
+ my $saved_lc_all = $ENV{LC_ALL} if $had_lc_all;
+
+ # Now try to set the locale via the environment. There is no
+ # point in calling the langinfo routines if this fails.
+ $ENV{LC_ALL} = $locale_id;
+ my $codeset;
+ my $lc_all = eval { POSIX::setlocale (LC_ALL, $locale_id); };
+ $codeset = I18N::Langinfo::langinfo (I18N::Langinfo::CODESET())
+ if defined $lc_all;
+
+ # Restore environment.
+ if ($saved_locale) {
+ eval { POSIX::setlocale (LC_ALL, $saved_locale); }
+ }
+ if ($had_lc_all) {
+ $ENV{LC_ALL} = $saved_lc_all if $had_lc_all;
+ } else {
+ delete $ENV{LC_ALL};
+ }
+ return $codeset;
+ }
+
+ return;
+}
+
+sub __untaint_plural_header {
+ my ($code) = @_;
+
+ # Whitespace, locale-independent.
+ my $s = '[ \t\r\n\013\014]';
+
+ if ($code =~ m{^($s*
+ nplurals$s*=$s*[0-9]+
+ $s*;$s*
+ plural$s*=$s*(?:$s|[-\?\|\&=!<>+*/\%:;a-zA-Z0-9_\(\)])+
+ )}xms) {
+ return $1;
+ }
+
+ return '';
}
-
+
+sub __compile_plural_function {
+ my ($code) = @_;
+
+ # The leading and trailing space is necessary to be able to match
+ # against word boundaries.
+ my $plural_func;
+
+ if (length $code) {
+ my $code = ' ' . $code . ' ';
+ $code =~
+ s/(?<=[^_a-zA-Z0-9])[_a-z][_A-Za-z0-9]*(?=[^_a-zA-Z0-9])/\$$&/gs;
+
+ $code = "sub { my \$n = shift || 0;
+ my (\$plural, \$nplurals);
+ $code;
+ return (\$nplurals, \$plural ? \$plural : 0); }";
+
+ # Now try to evaluate the code. There is no need to run the code in
+ # a Safe compartment. The above substitutions should have destroyed
+ # all evil code. Corrections are welcome!
+ #warn $code;
+ $plural_func = eval $code;
+ #warn $@ if $@;
+ undef $plural_func if $@;
+ }
+
+ # Default is Germanic plural (which is incorrect for French).
+ $plural_func = eval "sub { (2, 1 != shift || 0) }" unless $plural_func;
+
+ return $plural_func;
+}
+
1;
__END__
@@ -786,7 +875,7 @@ Locale::gettext_pp - Pure Perl Implementation of Uniforum Message Translation
=head1 SYNOPSIS
- use gettext_pp (:locale_h :libintl_h);
+ use Locale::gettext_pp qw(:locale_h :libintl_h);
gettext $msgid;
dgettext $domainname, $msgid;
@@ -819,14 +908,14 @@ for example used in GNU gettext and Sun's Solaris.
Normally you should not use this module directly, but the high
level interface Locale::TextDomain(3) that provides a much simpler
-interface. This description is therefore deliberately kept
-brief. Please refer to the GNU gettext documentation available at
+interface. This description is therefore deliberately kept
+brief. Please refer to the GNU gettext documentation available at
L<http://www.gnu.org/manual/gettext/> for in-depth and background
information on the topic.
=head1 FUNCTIONS
-The module exports by default nothing. Every function has to be
+The module exports by default nothing. Every function has to be
imported explicitely or via an export tag (L<"EXPORT TAGS">).
=over 4
@@ -893,6 +982,10 @@ See L<Locale::Messages/FUNCTIONS>.
See L<Locale::Messages/FUNCTIONS>.
+=item B<setlocale>
+
+See L<Locale::Messages/FUNCTIONS>.
+
=back
=head1 CONSTANTS
@@ -927,7 +1020,7 @@ You can import groups of functions via two tags:
=over 4
-=item B<use Locale::gettext_pp (':locale_h')>
+=item B<use Locale::gettext_pp qw(':locale_h')>
Imports the functions that are normally defined in the C include
file F<locale.h>:
@@ -1004,11 +1097,9 @@ Imports the locale category constants:
=head1 AUTHOR
-Copyright (C) 2002-2009, Guido Flohr E<lt>guido@imperia.netE<gt>, all
-rights reserved. See the source code for details.
-
-This software is contributed to the Perl community by Imperia
-(L<http://www.imperia.net/>).
+Copyright (C) 2002-2017 L<Guido Flohr|http://www.guido-flohr.net/>
+(L<mailto:guido.flohr@cantanea.com>), all rights reserved. See the source
+code for details!code for details!
=head1 SEE ALSO