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 50     50   1730119 use strict;
  50         389  
  50         1306  
3 50     50   223 use warnings;
  50         94  
  50         1036  
4 50     50   1143 use 5.008001;
  50         170  
5              
6             our $VERSION = '1.02';
7              
8             sub true () {
9 140     140 0 110683 require Data::MessagePack::Boolean;
10 50     50   305 no warnings 'once';
  50         147  
  50         3333  
11 140         821 return $Data::MessagePack::Boolean::true;
12             }
13              
14             sub false () {
15 172     172 0 14055 require Data::MessagePack::Boolean;
16 50     50   304 no warnings 'once';
  50         99  
  50         13659  
17 172         635 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 295     295 1 59200 my($class, %args) = @_;
36 295         764 return bless \%args, $class;
37             }
38              
39             foreach my $name(qw(canonical prefer_integer utf8)) {
40             my $setter = sub {
41 60     60   758 my($self, $value) = @_;
42 60 100       157 $self->{$name} = defined($value) ? $value : 1;
43 60         234 return $self;
44             };
45             my $getter = sub {
46 8     8   21 my($self) = @_;
47 8         25 return $self->{$name};
48             };
49 50     50   337 no strict 'refs';
  50         98  
  50         4870  
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__