File Coverage

blib/lib/Data/MessagePack.pm
Criterion Covered Total %
statement 28 28 100.0
branch 2 2 100.0
condition n/a
subroutine 11 11 100.0
pod 1 3 33.3
total 42 44 95.4


line stmt bran cond sub pod time code
1             package Data::MessagePack;
2 26     26   225360 use strict;
  26         34  
  26         600  
3 26     26   79 use warnings;
  26         29  
  26         477  
4 26     26   409 use 5.008001;
  26         60  
5              
6             our $VERSION = '1.00';
7              
8             sub true () {
9 62     62 0 71988 require Data::MessagePack::Boolean;
10 26     26   95 no warnings 'once';
  26         36  
  26         1377  
11 62         341 return $Data::MessagePack::Boolean::true;
12             }
13              
14             sub false () {
15 78     78 0 7287 require Data::MessagePack::Boolean;
16 26     26   88 no warnings 'once';
  26         24  
  26         5688  
17 78         228 return $Data::MessagePack::Boolean::false;
18             }
19              
20             if ( !__PACKAGE__->can('pack') ) { # this idea comes from Text::Xslate
21             my $backend = $ENV{PERL_DATA_MESSAGEPACK} || ($ENV{PERL_ONLY} ? 'pp' : '');
22             if ( $backend !~ /\b pp \b/xms ) {
23             eval {
24             require XSLoader;
25             XSLoader::load(__PACKAGE__, $VERSION);
26             };
27             die $@ if $@ && $backend =~ /\b xs \b/xms; # force XS
28             }
29             if ( !__PACKAGE__->can('pack') ) {
30             require 'Data/MessagePack/PP.pm';
31             }
32             }
33              
34             sub new {
35 31     31 1 28787 my($class, %args) = @_;
36 31         78 return bless \%args, $class;
37             }
38              
39             foreach my $name(qw(canonical prefer_integer utf8)) {
40             my $setter = sub {
41 30     30   421 my($self, $value) = @_;
42 30 100       80 $self->{$name} = defined($value) ? $value : 1;
43 30         116 return $self;
44             };
45             my $getter = sub {
46 4     4   8 my($self) = @_;
47 4         13 return $self->{$name};
48             };
49 26     26   98 no strict 'refs';
  26         29  
  26         2325  
50             *{$name} = $setter;
51             *{'get_' . $name} = $getter;
52             }
53              
54              
55             sub encode; *encode = __PACKAGE__->can('pack');
56             sub decode; *decode = __PACKAGE__->can('unpack');
57              
58             1;
59             __END__