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   11726 use Data::Hopen;
  16         41  
  16         905  
4 16     16   101 use strict;
  16         29  
  16         330  
5 16     16   77 use Data::Hopen::Base;
  16         33  
  16         96  
6              
7 16     16   4052 use overload;
  16         37  
  16         99  
8 16     16   785 use Scalar::Util qw(refaddr);
  16         34  
  16         1100  
9              
10             our $VERSION = '0.000018';
11              
12             sub name;
13              
14 16     16   1066 use Class::Tiny qw(name);
  16         3703  
  16         82  
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 12218 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       2099 if (@_>1) { # Setter
    100          
52 8 50       48 croak "Name `$_[1]' is disallowed" unless !!$_[1]; # no falsy names
53 8         32 return $_[0]->{name} = $_[1];
54             } elsif ( $_[0]->{name} ) { # Getter
55 375         3693 return $_[0]->{name};
56             } else { # Default
57 38         112 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 3969     3969 1 25043 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 3953 100   3953   244638 sprintf("%s (%x)", $_[0]->{name}, refaddr $_[0]) :
78             overload::StrVal($_[0]);
79             } #_stringify
80              
81 16         77 use overload fallback => 1,
82 16     16   5977 '""' => \&_stringify;
  16         36  
83              
84             1;
85             __END__