File Coverage

blib/lib/Data/IEEE754.pm
Criterion Covered Total %
statement 20 20 100.0
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 30 30 100.0


line stmt bran cond sub pod time code
1             package Data::IEEE754;
2             {
3             $Data::IEEE754::VERSION = '0.01';
4             }
5             BEGIN {
6 1     1   69792 $Data::IEEE754::AUTHORITY = 'cpan:DROLSKY';
7             }
8              
9 1     1   10 use strict;
  1         2  
  1         42  
10 1     1   6 use warnings;
  1         1  
  1         26  
11 1     1   1662 use utf8;
  1         12  
  1         6  
12              
13 1     1   38 use Config;
  1         2  
  1         55  
14              
15 1     1   6 use Exporter qw( import );
  1         2  
  1         702  
16              
17             our @EXPORT_OK = qw(
18             pack_double_be
19             pack_float_be
20             unpack_double_be
21             unpack_float_be
22             );
23              
24             # This code is all copied from Data::MessagePack::PP by Makamaka
25             # Hannyaharamitu, and was then tweaked by Dave Rolsky. Blame Dave for the
26             # bugs.
27             #
28             # Perl 5.10 introduced the ">" and "<" modifiers for pack which can be used to
29             # force a specific endianness.
30             if ( $] < 5.010 ) {
31             my $bo_is_le = ( $Config{byteorder} =~ /^1234/ );
32              
33             if ($bo_is_le) {
34             *pack_float_be = sub {
35             return pack( 'N1', unpack( 'V1', pack( 'f', $_[0] ) ) );
36             };
37             *pack_double_be = sub {
38             my @v = unpack( 'V2', pack( 'd', $_[0] ) );
39             return pack( 'N2', @v[ 1, 0 ] );
40             };
41              
42             *unpack_float_be = sub {
43             my @v = unpack( 'v2', $_[0] );
44             return unpack( 'f', pack( 'n2', @v[ 1, 0 ] ) );
45             };
46             *unpack_double_be = sub {
47             my @v = unpack( 'V2', $_[0] );
48             return unpack( 'd', pack( 'N2', @v[ 1, 0 ] ) );
49             };
50             }
51             else { # big endian
52             *pack_float_be = sub {
53             return pack 'f', $_[0];
54             };
55             *pack_double_be = sub {
56             return pack 'd', $_[0];
57             };
58              
59             *unpack_float_be
60             = sub { return unpack( 'f', $_[0] ); };
61             *unpack_double_be
62             = sub { return unpack( 'd', $_[0] ); };
63             }
64             }
65             else {
66             *pack_float_be = sub {
67 9     9   4144 return pack 'f>', $_[0];
68             };
69             *pack_double_be = sub {
70 14     14   7020 return pack 'd>', $_[0];
71             };
72              
73             *unpack_float_be = sub {
74 9     9   76 return unpack( 'f>', $_[0] );
75             };
76             *unpack_double_be = sub {
77 14     14   113 return unpack( 'd>', $_[0] );
78             };
79             }
80              
81             1;
82              
83             # ABSTRACT: Pack and unpack big-endian IEEE754 floats and doubles
84              
85             __END__
86              
87             =pod
88              
89             =head1 NAME
90              
91             Data::IEEE754 - Pack and unpack big-endian IEEE754 floats and doubles
92              
93             =head1 VERSION
94              
95             version 0.01
96              
97             =head1 SYNOPSIS
98              
99             use Data::IEEE754 qw( pack_double_be unpack_double_be );
100              
101             my $packed = pack_double_be(3.14);
102             my $double = unpack_double_be($packed);
103              
104             =head1 DESCRIPTION
105              
106             This module provides some simple convenience functions for packing and
107             unpacking IEEE 754 floats and doubles.
108              
109             If you can require Perl 5.10 or greater then this module is pointless. Just
110             use the C<< d> >> and C<< f> >> pack formats instead!
111              
112             Currently this module only implements big-endian order. Patches to add
113             little-endian order subroutines are welcome.
114              
115             =head1 EXPORTS
116              
117             This module optionally exports the following four functions:
118              
119             =over 4
120              
121             =item * pack_float_be($number)
122              
123             =item * pack_double_be($number)
124              
125             =item * unpack_float_be($binary)
126              
127             =item * unpack_double_be($binary)
128              
129             =back
130              
131             =head1 CREDITS
132              
133             The code in this module is more or less copied and pasted from
134             L<Data::MessagePack>'s C<Data::MessagePack::PP> module. That module was
135             written by Makamaka Hannyaharamitu. The code was then tweaked by Dave Rolsky,
136             so blame him for the bugs.
137              
138             =head1 AUTHOR
139              
140             Dave Rolsky <autarch@urth.org>
141              
142             =head1 COPYRIGHT AND LICENSE
143              
144             This software is Copyright (c) 2013 by MaxMind, Inc..
145              
146             This is free software, licensed under:
147              
148             The Artistic License 2.0 (GPL Compatible)
149              
150             =cut