File Coverage

lib/Contenticious/Content/Node.pm
Criterion Covered Total %
statement 28 31 90.3
branch 11 12 91.6
condition 3 3 100.0
subroutine 8 9 88.8
pod 1 6 16.6
total 51 61 83.6


line stmt bran cond sub pod time code
1             package Contenticious::Content::Node;
2 5     5   2413 use Mojo::Base -base;
  5         6369  
  5         32  
3              
4 5     5   553 use Carp;
  5         5  
  5         246  
5 5     5   28 use File::Basename 'basename';
  5         7  
  5         2299  
6              
7             has is_root => undef;
8             has filename => sub { croak 'no filename given' };
9             has name => sub { shift->build_name };
10             has path_prefix => '';
11             has path => sub { shift->build_path };
12             has meta => sub { {} };
13             has html => sub { shift->build_html };
14             has title => sub { shift->build_title };
15             has navi_name => sub { shift->build_navi_name };
16              
17             sub build_name {
18 97     97 0 88 my $self = shift;
19              
20             # root node
21 97 100       148 return '' if $self->is_root;
22              
23             # get last path part
24 94         377 my $base = basename($self->filename);
25              
26             # delete prefix
27 94         2746 $base =~ s/^\d+_//;
28            
29             # delete suffix
30 94         182 $base =~ s/\.\w+$//;
31              
32 94         366 return $base;
33             }
34              
35             sub build_path {
36 79     79 0 75 my $self = shift;
37              
38             # root node
39 79 100       159 return '' if $self->is_root;
40              
41             # build from path_prefix, infix slash and name
42 64         316 return join '/' => grep {$_ ne ''} $self->path_prefix, $self->name;
  128         604  
43             }
44              
45             sub build_html {
46 0     0 0 0 my $self = shift;
47 0         0 croak 'build_html needs to be overwritten by subclass';
48             }
49              
50             sub build_title {
51 24     24 0 32 my $self = shift;
52              
53             # try to extract title
54 24 100       62 return $self->meta->{title} if exists $self->meta->{title};
55 9 100 100     87 return $1 if defined $self->html and $self->html =~ m|

(.*?)

|i;
56 6         2093 return $self->name;
57             }
58              
59             sub build_navi_name {
60 57     57 0 65 my $self = shift;
61              
62             # try to find a proper name
63 57 100       146 return $self->meta->{navi_name} if exists $self->meta->{navi_name};
64 15         128 return $self->name;
65             }
66              
67             sub find {
68 24     24 1 34 my ($self, @names) = @_;
69              
70             # no search
71 24 50       89 return $self unless @names;
72              
73             # not found
74 0           return;
75             }
76              
77             1;
78              
79             __END__