File Coverage

blib/lib/CPAN/Changes/Release.pm
Criterion Covered Total %
statement 76 89 85.3
branch 17 26 65.3
condition 2 2 100.0
subroutine 20 22 90.9
pod 16 16 100.0
total 131 155 84.5


line stmt bran cond sub pod time code
1             package CPAN::Changes::Release;
2              
3 22     22   90 use strict;
  22         26  
  22         638  
4 22     22   86 use warnings;
  22         28  
  22         424  
5              
6 22     22   10408 use Text::Wrap ();
  22         50635  
  22         459  
7 22     22   7848 use CPAN::Changes::Group;
  22         207  
  22         618  
8 22     22   113 use Scalar::Util qw(blessed);
  22         24  
  22         18290  
9              
10             sub new {
11 87     87 1 102 my $class = shift;
12 87         587 return bless {
13             changes => {},
14             @_,
15             }, $class;
16             }
17              
18             sub version {
19 483     483 1 13818 my $self = shift;
20              
21 483 50       725 if ( @_ ) {
22 0         0 $self->{ version } = shift;
23             }
24              
25 483         1159 return $self->{ version };
26             }
27              
28             sub date {
29 56     56 1 9445 my $self = shift;
30              
31 56 50       140 if ( @_ ) {
32 0         0 $self->{ date } = shift;
33             }
34              
35 56         184 return $self->{ date };
36             }
37              
38             sub note {
39 29     29 1 36 my $self = shift;
40              
41 29 50       53 if ( @_ ) {
42 0         0 $self->{ note } = shift;
43             }
44              
45 29         60 return $self->{ note };
46             }
47              
48             sub changes {
49 79     79 1 106 my $self = shift;
50              
51 79 100       169 if ( @_ ) {
52 59         56 my $group = shift;
53 59 50       129 return unless exists $self->{ changes }->{ $group };
54 59         142 return $self->{ changes }->{ $group }->changes;
55             }
56              
57 20         29 return { map { $_ => $self->{ changes }->{$_}->changes } keys %{ $self->{ changes } } };
  19         77  
  20         81  
58             }
59              
60             sub add_changes {
61 116     116 1 129 my $self = shift;
62 116         112 my $group = '';
63              
64 116 100       224 if ( ref $_[ 0 ] ) {
65 115         143 $group = shift->{ group };
66             }
67              
68 116         205 $self->get_group( $group )->add_changes( @_ );
69             }
70              
71             sub set_changes {
72 0     0 1 0 my $self = shift;
73 0         0 my $group = '';
74              
75 0 0       0 if ( ref $_[ 0 ] ) {
76 0         0 $group = shift->{ group };
77             }
78              
79 0         0 $self->get_group( $group )->set_changes(@_);
80             }
81              
82             sub clear_changes {
83 1     1 1 6 my $self = shift;
84 1         4 $self->{ changes } = {};
85             }
86              
87             sub groups {
88 41     41 1 483 my $self = shift;
89 41         91 my %args = @_;
90              
91 41   100 37   248 $args{ sort } ||= sub { sort @_ };
  37         203  
92              
93 41         46 return $args{ sort }->( keys %{ $self->{ changes } } );
  41         133  
94             }
95              
96             sub get_group {
97 145     145 1 120 my $self = shift;
98 145         137 my $group = '';
99              
100 145 100       244 if ( $_[ 0 ] ) {
101 50         50 $group = shift;
102             }
103 145 100       315 if ( !exists $self->{ changes }->{ $group } ) {
104 62         223 $self->{ changes }->{ $group } = CPAN::Changes::Group->new( name => $group );
105             }
106 145 100       463 if ( not blessed $self->{changes}->{$group} ) {
107 7         23 $self->{ changes }->{ $group } = CPAN::Changes::Group->new( name => $group , changes => $self->{changes}->{$group} );
108             }
109              
110 145         418 return $self->{ changes }->{ $group };
111             }
112              
113             sub attach_group {
114 0     0 1 0 my $self = shift;
115 0         0 my $group = shift;
116              
117 0 0       0 die "Not a group" unless blessed $group;
118              
119 0         0 my $name = $group->name;
120              
121 0         0 $self->{changes}->{$name} = $group;
122              
123             }
124              
125             sub group_values {
126 20     20 1 19 my $self = shift;
127 20         40 return map { $self->get_group( $_ ) } $self->groups( @_ );
  29         62  
128             }
129              
130             sub add_group {
131 17     17 1 17 my $self = shift;
132 17         74 $self->{ changes }->{ $_ } = CPAN::Changes::Group->new( name => $_ ) for @_;
133             }
134              
135             sub delete_group {
136 2     2 1 3 my $self = shift;
137 2         3 my @groups = @_;
138              
139 2 50       5 @groups = ( '' ) unless @groups;
140              
141 2         18 delete $self->{ changes }->{ $_ } for @groups;
142             }
143              
144             sub delete_empty_groups {
145 4     4 1 4 my $self = shift;
146              
147 7         14 $self->delete_group($_->name)
148 4         8 for grep { $_->is_empty } $self->group_values;
149             }
150              
151             sub serialize {
152 16     16 1 492 my $self = shift;
153 16         23 my %args = @_;
154              
155 16 100       24 my $output = join( ' ', grep { defined && length } ( $self->version, $self->date, $self->note ) )
  48         159  
156             . "\n";
157              
158 22         53 $output .= join "\n",
159 16         52 map { $_->serialize } $self->group_values( sort => $args{ group_sort } );
160 16         34 $output .= "\n";
161              
162 16         58 return $output;
163             }
164              
165             1;
166              
167             __END__