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.0002';
4 17     17   56613 use 5.010;
  17         56  
5              
6 17     17   89 use Scalar::Util qw(blessed);
  17         32  
  17         762  
7              
8 17     17   446 use Class::Tiny::Antlers qw(-default around);
  17         3167  
  17         91  
9             #use Statistics::R::REXP::Types;
10 17     17   2525 use namespace::clean;
  17         8929  
  17         85  
11              
12             extends 'Statistics::R::REXP';
13              
14              
15 17     17   3714 use constant sexptype => 'SYMSXP';
  17         31  
  17         1412  
16              
17             has name => (
18             is => 'ro',
19             default => '',
20             );
21              
22             use overload
23 17     17   822 '""' => sub { 'symbol `'. shift->name .'`' };
  17     800   802  
  17         105  
  800         17424  
24              
25             sub BUILDARGS {
26 2749     2749 0 64819 my $class = shift;
27 2749         5287 my $attributes = {};
28            
29 2749 100       6872 if ( scalar @_ == 1) {
    100          
30 2718 50       6601 if ( ref $_[0] eq 'HASH' ) {
31 0         0 $attributes = $_[0]
32             }
33             else {
34 2718         7341 $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         76 $attributes = { @_ };
43             }
44            
45 2748 100 66     11841 if (blessed($attributes->{name}) &&
46             $attributes->{name}->isa('Statistics::R::REXP::Symbol')) {
47             $attributes->{name} = $attributes->{name}->name
48 2         42 }
49             $attributes
50 2748         5515 }
51              
52             sub BUILD {
53 2747     2747 0 22208 my ($self, $args) = @_;
54              
55 2747 100       43874 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 608 my $self = shift;
66 11         187 $self->name
67             }
68              
69              
70             1; # End of Statistics::R::REXP::Symbol
71              
72             __END__