File Coverage

blib/lib/POSIX/Wide.pm

Criterion	Covered	Total	%
statement	40	44	90.9
branch	2	6	33.3
condition			n/a
subroutine	14	15	93.3
pod	5	5	100.0
total	61	70	87.1

# Copyright 2009, 2010, 2011, 2014, 2024 Kevin Ryde

# This file is part of POSIX-Wide.
#
# POSIX-Wide 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, or (at your option) any later
# version.
#
# POSIX-Wide 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 General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with POSIX-Wide.  If not, see .


# Possible funcs:
#   asctime()
#   ctime()
#       Believe always ascii day/month, or at least that's what glibc gives.
#
# Different:
#   strcoll()
#   strxfrm()


package POSIX::Wide;
use 5.008;
use strict;
use warnings;
use POSIX ();
use Encode;
use Encode::Locale;  # has 'locale' from its initial 0.01 release

our $VERSION = 12;

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(localeconv perror strerror strftime tzname
                    $ERRNO $EXTENDED_OS_ERROR);
# not yet ...
# our %EXPORT_TAGS = (all => \@EXPORT_OK);

use POSIX::Wide::ERRNO;
tie (our $ERRNO, 'POSIX::Wide::ERRNO');

use POSIX::Wide::EXTENDED_OS_ERROR;
tie (our $EXTENDED_OS_ERROR, 'POSIX::Wide::EXTENDED_OS_ERROR');


our @LOCALECONV_STRING_FIELDS = (qw(decimal_point
                                    thousands_sep
                                    int_curr_symbol
                                    currency_symbol
                                    mon_decimal_point
                                    mon_thousands_sep
                                    positive_sign
                                    negative_sign));

# POSIX.xs of perl 5.10.1 has mon_thousands_sep conditionalized, so allow
# for it and maybe other fields to not exist.
#
# POSIX.xs omits fields which are empty strings "", so for example when
# positive_sign is an empty string (which is usual in an English locale)
# there's no such field in the POSIX::localeconv() return.
#
sub localeconv {
  my $l = POSIX::localeconv();
  foreach my $key (@LOCALECONV_STRING_FIELDS) {
    if (exists $l->{$key}) {
      $l->{$key} = _to_wide($l->{$key});
    }
  }
  return $l;
}

# STDERR like POSIX/perror.al
sub perror {
  if (@_) { print STDERR @_,': '; }
  print STDERR strerror($!),"\n";
}

sub strerror {
  return _to_wide (POSIX::strerror ($_[0]));
}

# \020-\176 is printable ascii
# only basic control chars are allows through to strftime, in particular Esc
# is excluded in case the locale is shift-jis etc and it means something
sub strftime {
  (my $fmt = shift) =~ s{(%[\020-\176\t\n\r\f\a]*)}
                        { _to_wide(POSIX::strftime($1,@_)) }ge;
  return $fmt;
}

sub tzname {
  return map {_to_wide($_)} POSIX::tzname();
}

sub _to_wide {
  my ($str) = @_;
  if (utf8::is_utf8($str)) { return $str; }

  # netbsd langinfo(CODESET) returns "646" meaning ISO-646, ie. ASCII.  Must
  # put that through resolve_alias() to turn it into "ascii".
  #
  return Encode::decode ('locale', $str, Encode::FB_CROAK());
}

1;
__END__