File Coverage

blib/lib/Data/Hopen/G/Entity.pm
Criterion Covered Total %
statement 29 29 100.0
branch 9 10 90.0
condition n/a
subroutine 10 10 100.0
pod 2 2 100.0
total 50 51 98.0


line stmt bran cond sub pod time code
1             # Data::Hopen::G::Entity - base class for hopen's data model
2             package Data::Hopen::G::Entity;
3 16     16   11963 use Data::Hopen;
  16         43  
  16         920  
4 16     16   92 use strict;
  16         35  
  16         670  
5 16     16   93 use Data::Hopen::Base;
  16         29  
  16         113  
6              
7 16     16   3603 use overload;
  16         37  
  16         96  
8 16     16   755 use Scalar::Util qw(refaddr);
  16         34  
  16         1090  
9              
10             our $VERSION = '0.000017';
11              
12             sub name;
13              
14 16     16   1067 use Class::Tiny qw(name);
  16         4125  
  16         95  
15              
16             =head1 NAME
17              
18             Data::Hopen::G::Entity - The base class for all hopen nodes and edges
19              
20             =head1 SYNOPSIS
21              
22             hopen creates and manages a graph of entities: nodes and edges. This class
23             holds common information.
24              
25             =head1 MEMBERS
26              
27             =head2 name
28              
29             The name of this entity. The name is for human consumption and is not used by
30             hopen to make any decisions. However, node names starting with an underscore
31             are reserved for hopen's internal use.
32              
33             The name C<'0'> (a single digit zero) is forbidden (since it's falsy).
34              
35             =cut
36              
37             =head1 FUNCTIONS
38              
39             =head2 name
40              
41             A custom accessor for name. If no name has been stored, return the stringifed
42             version of the entity. That way every entity always has a name.
43              
44             =cut
45              
46             sub name {
47 422 100   422 1 11470 croak 'Need an instance' unless ref $_[0];
48             # Note: avoiding `shift` since I've had problems with that in the past
49             # in classes that overload stringification.
50              
51 421 100       2209 if (@_>1) { # Setter
    100          
52 8 50       41 croak "Name `$_[1]' is disallowed" unless !!$_[1]; # no falsy names
53 8         31 return $_[0]->{name} = $_[1];
54             } elsif ( $_[0]->{name} ) { # Getter
55 375         3672 return $_[0]->{name};
56             } else { # Default
57 38         115 return overload::StrVal($_[0]);
58             }
59             } #name()
60              
61             =head2 has_custom_name
62              
63             Returns truthy if a name has been set using L.
64              
65             =cut
66              
67 4047     4047 1 25863 sub has_custom_name { !!($_[0]->{name}) }
68              
69             =head2 Stringification
70              
71             Stringifies to the name plus, if the name is custom, the refaddr.
72              
73             =cut
74              
75             sub _stringify {
76             $_[0]->has_custom_name ?
77 4031 100   4031   253445 sprintf("%s (%x)", $_[0]->{name}, refaddr $_[0]) :
78             overload::StrVal($_[0]);
79             } #_stringify
80              
81 16         100 use overload fallback => 1,
82 16     16   6264 '""' => \&_stringify;
  16         38  
83              
84             1;
85             __END__