File Coverage

blib/lib/PlantUML/ClassDiagram/Relation.pm
Criterion Covered Total %
statement 34 36 94.4
branch 6 6 100.0
condition 3 6 50.0
subroutine 8 8 100.0
pod 1 2 50.0
total 52 58 89.6


line stmt bran cond sub pod time code
1             package PlantUML::ClassDiagram::Relation;
2              
3 3     3   30296 use strict;
  3         6  
  3         77  
4 3     3   10 use warnings;
  3         4  
  3         68  
5 3     3   8 use utf8;
  3         7  
  3         18  
6              
7 3     3   1016 use parent qw/Class::Accessor::Fast/;
  3         602  
  3         13  
8             __PACKAGE__->follow_best_practice;
9              
10             my @self_valiables = qw/
11             name
12             from
13             to
14             /;
15             __PACKAGE__->mk_ro_accessors(@self_valiables);
16              
17             my $symbol_name_map = +{
18             '<-' => 'association',
19             '->' => 'association',
20             '<|-' => 'generalization',
21             '-|>' => 'generalization',
22             '<|.' => 'realization',
23             '.|>' => 'realization',
24             'o-' => 'aggregation',
25             '-o' => 'aggregation',
26             '*-' => 'composite',
27             '-*' => 'composite',
28             };
29              
30             my $symbol_is_from_right_side = +{
31             '<-' => 1,
32             '<|-' => 1,
33             '<|.' => 1,
34             'o-' => 1,
35             '*-' => 1,
36             '-|>' => 0,
37             '->' => 0,
38             '.|>' => 0,
39             '-o' => 0,
40             '-*' => 0,
41             };
42              
43             sub new {
44 23     23 1 13410 my ($class, $name, $from, $to) = @_;
45 23   50     110 my $attr = +{
      50        
      50        
46             name => $name || '',
47             from => $from || '',
48             to => $to || '',
49             };
50 23         82 return $class->SUPER::new($attr);
51             }
52              
53             sub build {
54 19     19 0 18857 my ($class, $string) = @_;
55              
56 19         16 my ($symbol, $left, $right);
57 19         93 $string =~ /([\w|:]+)\s+(.+?)\s+([\w|:]+)/;
58              
59 19         38 $left = $1;
60 19         21 $symbol = $2;
61 19         18 $right = $3;
62              
63 19         30 my $name = $class->_get_symbol_name($symbol);
64 19         49 my ($from, $to) = $class->_get_from_and_to($symbol, $left, $right);
65              
66 19         46 return $class->new($name, $from, $to);
67             }
68              
69             sub _get_symbol_name {
70 19     19   19 my ($class, $symbol) = @_;
71 19         54 for my $pattern (keys %$symbol_name_map){
72 125         103 my $escaped_pattern = quotemeta($pattern);
73 125 100       799 return $symbol_name_map->{$pattern} if $symbol =~ /$escaped_pattern/;
74             }
75              
76 0         0 return undef;
77             }
78              
79             # return (from, to)
80             sub _get_from_and_to {
81 19     19   25 my ($class, $symbol, $left, $right) = @_;
82              
83 19         40 for my $pattern (keys %$symbol_is_from_right_side){
84 119         87 my $escaped_pattern = quotemeta($pattern);
85 119 100       595 if ($symbol =~ /$escaped_pattern/) {
86              
87 19 100       51 return ($right, $left) if $symbol_is_from_right_side->{$pattern};
88 8         15 return ($left, $right);
89             }
90             }
91              
92 0           return ($left, $right);
93             }
94              
95             1;