File Coverage

blib/lib/PFT/Content/Base.pm
Criterion Covered Total %
statement 23 28 82.1
branch 0 2 0.0
condition 1 3 33.3
subroutine 9 11 81.8
pod 2 3 66.6
total 35 47 74.4


line stmt bran cond sub pod time code
1             # Copyright 2014-2016 - Giovanni Simoni
2             #
3             # This file is part of PFT.
4             #
5             # PFT is free software: you can redistribute it and/or modify it under the
6             # terms of the GNU General Public License as published by the Free
7             # Software Foundation, either version 3 of the License, or (at your
8             # option) any later version.
9             #
10             # PFT is distributed in the hope that it will be useful, but WITHOUT ANY
11             # WARRANTY; without even the implied warranty of MERCHANTABILITY or
12             # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with PFT. If not, see .
17             #
18             package PFT::Content::Base v1.4.0;
19              
20             =encoding utf8
21              
22             =head1 NAME
23              
24             PFT::Content::Base - Base class for content
25              
26             =head1 SYNOPSIS
27              
28             use parent 'PFT::Content::Base'
29              
30             sub new {
31             my $cls = shift;
32             ...
33             $cls->SUPER::new({
34             tree => $tree,
35             name => $name,
36             })
37             ...
38             }
39              
40             =head1 DESCRIPTION
41              
42             This class is a common base for for all C classes.
43              
44             =cut
45              
46 6     6   2563 use utf8;
  6         14  
  6         30  
47 6     6   189 use v5.16;
  6         18  
48 6     6   27 use strict;
  6         8  
  6         112  
49 6     6   33 use warnings;
  6         11  
  6         151  
50              
51 6     6   26 use Carp;
  6         11  
  6         1924  
52              
53             sub new {
54 133     133 0 200 my $cls = shift;
55 133         175 my $params = shift;
56              
57             exists $params->{$_} or confess "Missing param: $_"
58 133   33     503 for qw/tree name/;
59              
60             bless {
61             tree => $params->{tree},
62             name => $params->{name},
63 133         472 }, $cls
64             }
65              
66             =head2 Properties
67              
68             =over
69              
70             =item tree
71              
72             Path object
73              
74             =item name
75              
76             Name of the object
77              
78             =cut
79              
80 4     4 1 20 sub tree { shift->{tree} }
81              
82 1     1 1 12 sub name { shift->{name} }
83              
84             use overload
85             '""' => sub {
86 0     0   0 my $self = shift;
87 0         0 ref($self) . '({name => "' . $self->{name} . '"})'
88             },
89             'cmp' => sub {
90 0     0   0 my($self, $oth, $swap) = @_;
91 0         0 my $out = $self->name cmp $oth->name;
92 0 0       0 $swap ? -$out : $out;
93             }
94 6     6   4942 ;
  6         4053  
  6         72  
95              
96             =back
97              
98             =cut
99              
100             1;