File Coverage

blib/lib/CPAN/Changes/HasEntries.pm
Criterion Covered Total %
statement 35 42 83.3
branch 4 10 40.0
condition 2 6 33.3
subroutine 9 10 90.0
pod 0 5 0.0
total 50 73 68.4


line stmt bran cond sub pod time code
1             package CPAN::Changes::HasEntries;
2 33     33   384512 use strict;
  33         84  
  33         1404  
3 33     33   172 use warnings;
  33         64  
  33         3295  
4              
5             our $VERSION = '0.500005';
6             $VERSION =~ tr/_//d;
7              
8 33     33   835 use Sub::Quote qw(qsub);
  33         8630  
  33         2753  
9 33     33   1376 use Types::Standard qw(ArrayRef InstanceOf Str);
  33         217820  
  33         372  
10              
11 33     33   73758 use Moo::Role;
  33         76  
  33         295  
12              
13             my $entry_type = (InstanceOf['CPAN::Changes::Entry'])->plus_coercions(
14             Str ,=> qsub q{ CPAN::Changes::Entry->new(text => $_[0]) },
15             );
16              
17             has entries => (
18             is => 'rw',
19             default => sub { [] },
20             isa => ArrayRef[$entry_type],
21             coerce => 1,
22             );
23              
24             sub clone {
25 15     15 0 338 my $self = shift;
26 15         53 my %attrs = %$self;
27 15         24 $attrs{entries} = [ map $_->clone, @{$self->entries} ];
  15         1437  
28 15         1145 (ref $self)->new(%attrs, @_);
29             }
30              
31             sub has_entries {
32 153     153 0 310 my $self = shift;
33 153   66     3160 !!($self->entries && @{$self->entries});
34             }
35              
36             sub find_entry {
37 2     2 0 16 my ($self, $find) = @_;
38             return undef
39 2 50       7 unless $self->has_entries;
40 2 100       23 if (ref $find ne 'Regexp') {
41 1         22 $find = qr/\A\Q$find\E\z/;
42             }
43 2         3 my ($entry) = grep { $_->text =~ $find } @{ $self->entries };
  11         45  
  2         23  
44 2         8 return $entry;
45             }
46              
47             around serialize => sub {
48             my ($orig, $self, %args) = @_;
49             my $indents = $args{indents} || [];
50             my $styles = $args{styles} || [];
51             my $width = $args{width} || 75;
52             $indents = [ @{$indents}[1 .. $#$indents], ' '],
53             $styles = [ @{$styles}[1 .. $#$styles], '-'],
54             my $out = $self->$orig(@_);
55             my $entries = $self->entries || [];
56             for my $entry ( @$entries ) {
57             my $sub = $entry->serialize(
58             indents => $indents,
59             styles => $styles,
60             width => $width - length $indents->[0],
61             );
62             $sub =~ s/^(.)/$indents->[0]$1/mg;
63             $sub .= "\n"
64             if $entry->has_entries;
65             $out .= $sub;
66             }
67             $out =~ s/\n\n+\z/\n/;
68             return $out;
69             };
70              
71             sub add_entry {
72 11     11 0 327 my ($self, @entries) = @_;
73             $_ = $entry_type->coerce($_)
74 11         70 for @entries;
75 11         803 push @{ $self->entries }, @entries;
  11         299  
76 11 50       148 return wantarray ? @entries : $entries[-1];
77             }
78              
79             sub remove_entry {
80 0     0 0   my ($self, $entry) = @_;
81 0 0 0       $entry
82             = ref $entry && $entry->isa('CPAN::Changes::Entry') ? $entry
83             : $self->find_entry($entry);
84 0 0         return unless $entry;
85 0           my @entries = grep { $_ != $entry } @{ $self->entries };
  0            
  0            
86 0           $self->entries(\@entries);
87             }
88              
89             require CPAN::Changes::Entry;
90             1;
91             __END__