File Coverage

blib/lib/POSIX/Wide.pm

Criterion	Covered	Total	%
statement	38	41	92.6
branch	2	4	50.0
condition			n/a
subroutine	13	14	92.8
pod	5	5	100.0
total	58	64	90.6

# Copyright 2009, 2010, 2011, 2014 Kevin Ryde

# This file is part of I18N-Langinfo-Wide.
#
# I18N-Langinfo-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.
#
# I18N-Langinfo-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 I18N-Langinfo-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 I18N::Langinfo::Wide 'to_wide';

our $VERSION = 8;

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();
}


1;
__END__