File Coverage

blib/lib/Statistics/R/REXP/Symbol.pm
Criterion Covered Total %
statement 32 33 96.9
branch 9 10 90.0
condition 2 3 66.6
subroutine 10 10 100.0
pod 1 3 33.3
total 54 59 91.5


line stmt bran cond sub pod time code
1             package Statistics::R::REXP::Symbol;
2             # ABSTRACT: an R symbol
3             $Statistics::R::REXP::Symbol::VERSION = '1.0001';
4 17     17   16495 use 5.010;
  17         32  
5              
6 17     17   53 use Scalar::Util qw(blessed);
  17         17  
  17         721  
7              
8 17     17   480 use Class::Tiny::Antlers qw(-default around);
  17         3883  
  17         71  
9             #use Statistics::R::REXP::Types;
10 17     17   1949 use namespace::clean;
  17         9216  
  17         66  
11              
12             extends 'Statistics::R::REXP';
13              
14              
15 17     17   2072 use constant sexptype => 'SYMSXP';
  17         18  
  17         1234  
16              
17             has name => (
18             is => 'ro',
19             default => '',
20             );
21              
22             use overload
23 17     17   957 '""' => sub { 'symbol `'. shift->name .'`' };
  17     800   686  
  17         98  
  800         16508  
24              
25             sub BUILDARGS {
26 2749     2749 0 187549 my $class = shift;
27 2749         2590 my $attributes = {};
28            
29 2749 100       4579 if ( scalar @_ == 1) {
    100          
30 2718 50       4215 if ( ref $_[0] eq 'HASH' ) {
31 0         0 $attributes = $_[0]
32             }
33             else {
34 2718         4969 $attributes->{name} = $_[0]
35             }
36             }
37             elsif ( @_ % 2 ) {
38 1         7 die "The new() method for $class expects a hash reference or a key/value list."
39             . " You passed an odd number of arguments\n";
40             }
41             else {
42 30         52 $attributes = { @_ };
43             }
44            
45 2748 100 66     8515 if (blessed($attributes->{name}) &&
46             $attributes->{name}->isa('Statistics::R::REXP::Symbol')) {
47             $attributes->{name} = $attributes->{name}->name
48 2         47 }
49             $attributes
50 2748         3940 }
51              
52             sub BUILD {
53 2747     2747 0 15852 my ($self, $args) = @_;
54              
55 2747 100       38449 die "Attribute 'name' must be a scalar value" unless ref(\$self->name) eq 'SCALAR'
56             }
57              
58             around _eq => sub {
59             my $orig = shift;
60             $orig->(@_) and ($_[0]->name eq $_[1]->name);
61             };
62              
63              
64             sub to_pl {
65 11     11 1 430 my $self = shift;
66 11         181 $self->name
67             }
68              
69              
70             1; # End of Statistics::R::REXP::Symbol
71              
72             __END__