File Coverage

blib/lib/Autodia/Diagram/Relation.pm
Criterion Covered Total %
statement 12 70 17.1
branch 0 6 0.0
condition 0 3 0.0
subroutine 4 15 26.6
pod 0 9 0.0
total 16 103 15.5


line stmt bran cond sub pod time code
1             ################################################################
2             # Autodia - Automatic Dia XML. Copyright 2001 - 2008 A Trevena #
3             # #
4             # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file #
5             # This is free software, and you are welcome to redistribute #
6             # it under certain conditions; see COPYING file for details #
7             ################################################################
8             package Autodia::Diagram::Relation;
9              
10 1     1   5 use strict;
  1         3  
  1         35  
11              
12 1     1   5 use vars qw($VERSION @ISA @EXPORT);
  1         2  
  1         69  
13 1     1   28 use Exporter;
  1         2  
  1         35  
14              
15 1     1   5 use Autodia::Diagram::Object;
  1         2  
  1         1029  
16              
17             @ISA = qw(Autodia::Diagram::Object);
18              
19             my $relation_count = 0;
20              
21             #--------------------------------------------------------------------
22             # Constructor Methods
23              
24             sub new
25             {
26 0     0 0   my $class = shift;
27 0           my $left = shift;
28 0           my $right = shift;
29 0           my $DiagramRelation = {};
30              
31 0   0       bless ($DiagramRelation, ref($class) || $class);
32 0           $DiagramRelation->_initialise($left, $right);
33              
34 0           return $DiagramRelation;
35             }
36              
37             #--------------------------------------------------------------------
38             # Access Methods
39              
40             sub Left {
41 0     0 0   my $self = shift;
42 0           my $left = shift;
43              
44 0 0         if (defined $left) {
45 0           $self->{"left"} = $left;
46             }
47 0           return $self->{"left"};
48             }
49              
50             sub Right {
51 0     0 0   my $self = shift;
52 0           my $right = shift;
53              
54 0 0         if (defined $right){
55 0           $self->{"_right"} = $right;
56 0           $self->{"right"} = $right->Id;
57             }
58 0           return $self->{"right"};
59             }
60              
61             sub Name {
62 0     0 0   my $self = shift;
63 0           my $name = shift;
64              
65 0 0         if (defined $name) {
66 0           $self->{"name"} = $name;
67             }
68 0           return $self->{"name"};
69             }
70              
71              
72             sub Orth_Top_Left
73             {
74 0     0 0   my $self = shift;
75 0           return $self->{"top_connection"};
76             }
77              
78             sub Orth_Bottom_Right
79             {
80 0     0 0   my $self = shift;
81 0           return $self->{"bottom_connection"};
82             }
83              
84             sub Orth_Mid_Left
85             {
86 0     0 0   my $self = shift;
87 0           my $return = ($self->{"left_x"}). "," . $self->{"mid_y"};
88              
89 0           return $return;
90             }
91              
92             sub Orth_Mid_Right
93             {
94 0     0 0   my $self = shift;
95 0           my $return = ($self->{"right_x"}). "," . $self->{"mid_y"};
96              
97 0           return $return;
98             }
99              
100             sub Reposition
101             {
102 0     0 0   my $self = shift;
103              
104 0           my $right = $self->{"_right"};
105              
106 0           my ($right_x,$bottom_y) = split (",",$right->TopLeftPos);
107 0           my $mid_y = $bottom_y - 1.5;
108 0           my $top_y= $mid_y - 1.5;
109              
110 0           $right_x += 2 + ($right->Width / 2);
111 0           my $left_x = $right_x - 5;
112              
113 0           $self->{"left_x"} = $left_x;
114 0           ($self->{"right_x"}, $self->{"top_y"},
115             $self->{"mid_y"}, $self->{"bottom_y"}) = ($right_x, $top_y, $mid_y, $bottom_y);
116 0           $self->{"top_connection"} = $self->{left_x} . "," . $self->{"top_y"};
117 0           $self->{"bottom_connection"} = $right_x . "," . $bottom_y;
118              
119 0           return 1;
120             }
121              
122              
123             #------------------------------------------------------
124             # Internal Methods
125              
126             sub _initialise # over-rides method in DiagramObject
127             {
128 0     0     my $self = shift;
129 0           my $left = shift;
130 0           my $right = shift;
131              
132 0           $self->{"_right"} = $right;
133 0           $self->{"right"} = $right->Id;
134 0           $self->{"type"} = "relation";
135 0           $self->{"_left"} = $left;
136 0           $self->{"left"} = $left->Id;
137 0           $self->{"name"} = $self->{"left"}."-".$self->{"right"};
138              
139             # TODO:
140             # add left label and right label
141             # check for existing relationship between two objects, re-use that one if exists and set reverse label from that
142              
143 0           return 1;
144             }
145              
146             sub _update # over-rides method in DiagramObject
147             {
148 0     0     my $self = shift;
149 0           $self->reposition();
150 0           return 1;
151             }
152              
153             1;