File Coverage

blib/lib/GraphViz/Graph/Label.pm
Criterion Covered Total %
statement 9 37 24.3
branch 0 16 0.0
condition n/a
subroutine 3 6 50.0
pod 0 3 0.0
total 12 62 19.3


line stmt bran cond sub pod time code
1             package GraphViz::Graph::Label;
2              
3 9     9   54 use warnings;
  9         19  
  9         237  
4 9     9   40 use strict;
  9         16  
  9         141  
5              
6 9     9   34 use Carp;
  9         16  
  9         2705  
7              
8             #_{ Version
9             our $VERSION = $GraphViz::Graph::Version;
10             #_}
11             #_{ Methods
12             #_{ POD
13             =encoding utf8
14              
15             =head1 METHODS
16              
17             =cut
18              
19             #_}
20             sub new { #_{
21             #_{ POD
22             =head2 new
23              
24             =cut
25             #_}
26 0     0 0   my $class = shift;
27 0           my $opts = shift;
28 0           my $self = {};
29              
30 0 0         croak 'Options expected' unless defined $opts;
31 0 0         croak 'Options must be a HASH' unless ref $opts eq 'HASH';
32              
33 0 0         if ($opts->{text}) {
    0          
34 0           $self->{type} = 'text';
35 0           $self->{text_or_html} = delete $opts->{text};
36             }
37             elsif ($opts->{html}) {
38 0           $self->{type} = 'html';
39 0           $self->{text_or_html} = delete $opts->{html};
40             }
41             else {
42 0           croak "A label must be either a text or a html label";
43             }
44              
45 0 0         croak "Unrecognized opts " . join "/", keys %$opts if keys %$opts;
46              
47 0           bless $self, $class;
48 0           return $self;
49              
50             } #_}
51             sub loc { #_{
52             #_{ POD
53             =head2 loc
54              
55             my $label = $graph -> label(…);
56             $label->loc('t'); # put label to top of graph
57              
58             For I, only C<"t"> (I)and C<"b"> (I, default) are allowed.
59              
60             Possible values for I seem to be C<"t">, C<"b"> and C<"c"> (I, default). The value is only used when the height of the node is larger than the height of its label.
61              
62             =cut
63             #_}
64 0     0 0   my $self = shift;
65 0           my $loc = shift;
66              
67 0 0         carp "$loc is not in c, b, t" unless grep { $_ eq $loc} qw(c b t);
  0            
68              
69 0           $self->{loc} = $loc;
70              
71 0           return $self;
72              
73             } #_}
74             sub dot_text { #_{
75             #_{ POD
76             =head2 dot_text
77              
78             =cut
79             #_}
80              
81 0     0 0   my $self = shift;
82              
83 0           my $ret = '';
84              
85 0 0         if ($self->{type} eq 'text') {
86              
87 0           $ret = "
88             label=\"$self->{text_or_html}\"
89             ";
90              
91             }
92             else {
93 0           $ret = "
94             label=<$self->{text_or_html}>
95             ";
96              
97             }
98 0 0         if ($self->{loc}) {
99 0           $ret .= " labelloc=$self->{loc}
100             ";
101             }
102              
103 0           return $ret;
104              
105             } #_}
106              
107             #_}
108              
109             'tq84';