File Coverage

lib/OODoc/Text.pm
Criterion Covered Total %
statement 18 60 30.0
branch 0 16 0.0
condition 0 8 0.0
subroutine 6 23 26.0
pod 11 12 91.6
total 35 119 29.4


line stmt bran cond sub pod time code
1             # Copyrights 2003-2013 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.00.
5              
6             package OODoc::Text;
7 1     1   4 use vars '$VERSION';
  1         2  
  1         37  
8             $VERSION = '2.00';
9              
10 1     1   5 use base 'OODoc::Object';
  1         2  
  1         302  
11              
12 1     1   7 use strict;
  1         1  
  1         24  
13 1     1   6 use warnings;
  1         2  
  1         24  
14              
15 1     1   5 use Log::Report 'oodoc';
  1         1  
  1         4  
16              
17              
18 0     0     use overload '==' => sub {$_[0]->unique == $_[1]->unique}
19 0     0     , '!=' => sub {$_[0]->unique != $_[1]->unique}
20 0     0     , '""' => sub {$_[0]->name}
21 0     0     , 'cmp' => sub {$_[0]->name cmp "$_[1]"}
22 1     1   308 , 'bool' => sub {1};
  1     0   3  
  1         23  
  0            
23              
24             #-------------------------------------------
25              
26              
27             my $unique = 1;
28              
29             sub init($)
30 0     0 0   { my ($self, $args) = @_;
31 0 0         $self->SUPER::init($args) or return;
32              
33 0           $self->{OT_name} = delete $args->{name};
34              
35 0 0         my $nr = $self->{OT_linenr} = delete $args->{linenr} or panic;
36 0 0         $self->{OT_type} = delete $args->{type} or panic;
37              
38 0 0         exists $args->{container} # may be explicit undef
39             or panic "no text container specified for the {pkg} object"
40             , pkg => ref $self;
41              
42             ; # may be undef
43 0           $self->{OT_container}= delete $args->{container};
44            
45 0   0       $self->{OT_descr} = delete $args->{description} || '';
46 0           $self->{OT_examples} = [];
47 0           $self->{OT_unique} = $unique++;
48              
49 0           $self;
50             }
51              
52             #-------------------------------------------
53              
54              
55 0     0 1   sub name() {shift->{OT_name}}
56              
57              
58 0     0 1   sub type() {shift->{OT_type}}
59              
60              
61             sub description()
62 0     0 1   { my $text = shift->{OT_descr};
63 0           my @lines = split /^/m, $text;
64 0   0       shift @lines while @lines && $lines[ 0] =~ m/^\s*$/;
65 0   0       pop @lines while @lines && $lines[-1] =~ m/^\s*$/;
66 0           join '', @lines;
67             }
68              
69              
70             sub container(;$)
71 0     0 1   { my $self = shift;
72 0 0         @_ ? ($self->{OT_container} = shift) : $self->{OT_container};
73             }
74              
75              
76             sub manual(;$)
77 0     0 1   { my $self = shift;
78 0 0         @_ ? $self->SUPER::manual(@_)
79             : $self->container->manual;
80             }
81              
82              
83 0     0 1   sub unique() {shift->{OT_unique}}
84              
85              
86             sub where()
87 0     0 1   { my $self = shift;
88 0           ($self->manual->source, $self->{OT_linenr});
89             }
90              
91             #-------------------------------------------
92              
93              
94 0     0 1   sub openDescription() { \shift->{OT_descr} }
95              
96              
97             sub findDescriptionObject()
98 0     0 1   { my $self = shift;
99 0 0         return $self if length $self->description;
100              
101 0           my @descr = map { $_->findDescriptionObject } $self->extends;
  0            
102 0 0         wantarray ? @descr : $descr[0];
103             }
104              
105              
106             sub example($)
107 0     0 1   { my ($self, $example) = @_;
108 0           push @{$self->{OT_examples}}, $example;
  0            
109 0           $example;
110             }
111              
112              
113 0     0 1   sub examples() { @{shift->{OT_examples}} }
  0            
114              
115             #-------------------------------------------
116              
117              
118             1;