File Coverage

blib/lib/POSIX/Wide/ERRNO.pm
Criterion Covered Total %
statement 22 26 84.6
branch 2 6 33.3
condition n/a
subroutine 7 8 87.5
pod n/a
total 31 40 77.5


line stmt bran cond sub pod time code
1             # Copyright 2009, 2010, 2012, 2014 Kevin Ryde
2              
3             # This file is part of POSIX-Wide.
4             #
5             # POSIX-Wide is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # POSIX-Wide is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with POSIX-Wide. If not, see .
17              
18             package POSIX::Wide::ERRNO;
19 1     1   19 use 5.008001; # for utf8::is_utf8()
  1         3  
  1         33  
20 1     1   4 use strict;
  1         1  
  1         26  
21 1     1   3 use warnings;
  1         2  
  1         19  
22 1     1   3 use Scalar::Util;
  1         2  
  1         206  
23              
24             # uncomment this to run the ### lines
25             #use Smart::Comments;
26              
27             our $VERSION = 10;
28              
29             sub TIESCALAR {
30 1     1   2 my ($class) = @_;
31 1         1 my $self;
32 1         4 return bless \$self, $class;
33             }
34              
35             # dualvar() in Scalar::Util 1.22 (post perl 5.10.1) will propagate the
36             # utf8 flag on its own, for prior versions must turn it on explicitly
37             #
38             BEGIN {
39 1 50   1   2 if (do { my $u = 'x';
  1         1  
40 1         3 utf8::upgrade($u);
41 1         9 my $e = Scalar::Util::dualvar(0,$u);
42 1         5 utf8::is_utf8($e) }) {
43             ### dualvar() is utf8
44 1 50       69 eval "\n#line ".(__LINE__+1)." \"".__FILE__."\"\n" . <<'HERE' or die;
45             sub FETCH {
46 4     4   1568 return Scalar::Util::dualvar
47             ($!, POSIX::Wide::_to_wide("$!"));
48             }
49             1;
50             HERE
51             } else {
52             ### dualvar() is not utf8, using _utf8_on()
53 0         0 require Encode;
54 0 0       0 eval "\n#line ".(__LINE__+1)." \"".__FILE__."\"\n" . <<'HERE' or die;
55             sub FETCH {
56             my $e = Scalar::Util::dualvar
57             ($!, POSIX::Wide::_to_wide("$!"));
58             Encode::_utf8_on($e);
59             return $e;
60             }
61             1;
62             HERE
63             }
64             }
65              
66             sub STORE {
67 0     0     my ($self, $value) = @_;
68 0           $! = $value;
69             }
70              
71             1;
72             __END__