File Coverage

lib/PlantUML/ClassDiagram/Class.pm
Criterion Covered Total %
statement 47 49 95.9
branch 16 18 88.8
condition 8 12 66.6
subroutine 11 12 91.6
pod 1 4 25.0
total 83 95 87.3


line stmt bran cond sub pod time code
1             package PlantUML::ClassDiagram::Class;
2              
3 2     2   2433 use strict;
  2         2  
  2         42  
4 2     2   5 use warnings;
  2         3  
  2         34  
5 2     2   5 use utf8;
  2         2  
  2         6  
6              
7 2     2   844 use PlantUML::ClassDiagram::Class::Factory;
  2         3  
  2         51  
8 2     2   8 use parent qw/Class::Accessor::Fast/;
  2         2  
  2         6  
9             __PACKAGE__->follow_best_practice;
10              
11             my @self_valiables = qw/
12             name
13             attribute
14             variables
15             methods
16             relations
17             /;
18             __PACKAGE__->mk_ro_accessors(@self_valiables);
19              
20             sub new {
21 10     10 1 21 my ($class, $name, $attribute, $variables, $methods, $relations) = @_;
22 10 100 50     107 my $attr = +{
    100 100        
    100 50        
      50        
      50        
23             name => $name || '',
24             attribute => $attribute || '',
25             variables => ( $variables && scalar @$variables ) ? $variables : +[],
26             methods => ( $methods && scalar @$methods ) ? $methods : +[],
27             relations => ( $relations && scalar @$relations ) ? $relations : +[],
28             };
29 10         23 return $class->SUPER::new($attr);
30             }
31              
32             sub build {
33 10     10 0 24 my ($class, $class_string, $relations) = @_;
34              
35 10         40 my @lines = split(/\n/, $class_string);
36 10         12 my $class_name_string = shift @lines;
37              
38 10         19 my $class_name = $class->_get_class_name($class_name_string);
39 10         20 my $class_attribute = $class->_get_class_attribute($class_name_string);
40 10         49 my $class_relations = $class->_get_relations( $class_name, $relations );
41              
42             # variables and methods
43 10         68 my ($class_variables, $class_methods) = (+[], +[]);
44 10         15 for my $line (@lines) {
45 44         36 chomp $line;
46 44         84 my $instance = PlantUML::ClassDiagram::Class::Factory->create($line);
47 44 100       298 next unless $instance;
48              
49 34 100       56 push( @$class_variables, $instance ) if $instance->is_variable;
50 34 100       63 push( @$class_methods, $instance ) if $instance->is_method;
51             }
52              
53 10         19 return $class->new(
54             $class_name,
55             $class_attribute,
56             $class_variables,
57             $class_methods,
58             $class_relations
59             );
60             }
61              
62             sub _get_class_name {
63 13     13   1103 my ($class, $class_name_string) = @_;
64              
65 13         92 my ($class_name) = $class_name_string =~ /class\s+([\w|:]+)\s+.*\{/;
66 13         24 return $class_name;
67             }
68              
69             sub _get_class_attribute {
70 12     12   950 my ($class, $class_name_string) = @_;
71              
72 12         24 my ($attribute) = $class_name_string =~ /^(\w+)\s*class/;
73 12   100     46 return $attribute || '';
74             }
75              
76             sub _get_relations {
77 11     11   21 my ($class, $class_name, $relations) = @_;
78              
79             return +[ grep {
80 11 100       17 $_->get_from eq $class_name ||
  76         412  
81             $_->get_to eq $class_name
82             } @$relations ];
83             }
84              
85             sub get_parents {
86 2     2 0 8785 my ($self) = @_;
87              
88             my $parent_relations = +[ grep {
89 5 100       41 $_->get_name eq 'generalization' &&
90             $_->get_from eq $self->get_name
91 2         4 } @{$self->get_relations} ];
  2         8  
92              
93 2         20 return +[ map { $_->get_to } @$parent_relations ];
  2         6  
94             }
95              
96             sub is_abstract {
97 0     0 0   my ($self) = @_;
98              
99 0 0         return ($self->get_attribute eq 'abstract') ? 1 : 0;
100             }
101              
102             1;