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   11961 use Data::Hopen;
  16         36  
  16         866  
4 16     16   94 use strict;
  16         32  
  16         324  
5 16     16   96 use Data::Hopen::Base;
  16         32  
  16         107  
6              
7 16     16   3508 use overload;
  16         39  
  16         90  
8 16     16   730 use Scalar::Util qw(refaddr);
  16         33  
  16         1040  
9              
10             our $VERSION = '0.000019';
11              
12             sub name;
13              
14 16     16   1174 use Class::Tiny qw(name);
  16         3690  
  16         96  
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 11322 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       2177 if (@_>1) { # Setter
    100          
52 8 50       49 croak "Name `$_[1]' is disallowed" unless !!$_[1]; # no falsy names
53 8         31 return $_[0]->{name} = $_[1];
54             } elsif ( $_[0]->{name} ) { # Getter
55 375         3611 return $_[0]->{name};
56             } else { # Default
57 38         104 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 3559     3559 1 22612 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 3543 100   3543   266861 sprintf("%s (%x)", $_[0]->{name}, refaddr $_[0]) :
78             overload::StrVal($_[0]);
79             } #_stringify
80              
81 16         85 use overload fallback => 1,
82 16     16   6207 '""' => \&_stringify;
  16         45  
83              
84             1;
85             __END__