our
$VERSION
=
'0.500004'
;
$VERSION
=~
tr
/_//d;
use
Exporter; BEGIN {
*import
= \
&Exporter::import
};
our
@EXPORT
=
qw(changes_ok changes_file_ok)
;
our
$Test
= Test::Builder->new;
our
$Parser
= CPAN::Changes::Parser->new(
_release_class
=>
'Test::CPAN::Changes::Release'
,
);
sub
changes_ok {
local
$Test::Builder::Level
=
$Test::Builder::Level
+ 1;
my
(
$arg
) =
@_
;
$Test
->plan(
tests
=> (
$arg
&&
defined
$arg
->{version} ? 6 : 4 ) );
return
changes_file_ok(
undef
,
@_
);
}
{
package
Test::CPAN::Changes::Release;
has
raw_date
=> (
is
=>
'ro'
);
}
sub
changes_file_ok {
my
(
$file
,
$arg
) =
@_
;
$file
||=
'Changes'
;
$arg
||= {};
local
$Test::Builder::Level
=
$Test::Builder::Level
+ 1;
my
$tests
=
defined
$arg
->{version} ? 6 : 4;
my
$ok
= 1;
my
$changes
;
$Test
->ok(
!!
eval
{
$changes
=
$Parser
->parse_file(
$file
); 1 },
"$file is loadable"
) or
do
{
$Test
->diag(
"Error: $@"
);
$Test
->skip(
"can't test unparsable change log"
)
for
2 ..
$tests
;
return
!1;
};
my
@releases
=
map
$_
->[0],
sort
{
$a
->[1] <=>
$b
->[1] }
map
[
$_
,
$_
->line],
$changes
->releases;
$Test
->ok( !!
@releases
,
"$file contains at least one release"
) or
$ok
= 0;
my
$date_err
;
for
my
$release
(
@releases
) {
if
( !
defined
$release
->date ||
$release
->date eq
''
) {
$date_err
=
'No date for version '
.
$release
->version.
' (line '
.
$release
->line.
')'
;
last
;
}
my
$d
=
$release
->raw_date;
if
(
$d
!~ m{^${CPAN::Changes::Parser::_ISO_8601_DATE}$}
&&
$d
!~ m{^(${CPAN::Changes::Parser::_UNKNOWN_DATE})$}
) {
$Test
->note(
'Date "'
.
$d
.
'" is not in the recommended W3CDTF format, should be "'
.
$release
->date.
'" (line '
.
$release
->line.
')'
);
}
}
$Test
->ok( !
defined
$date_err
,
"$file contains all valid release dates"
)
or
$Test
->diag(
' ERR: '
.
$date_err
),
$ok
= 0;
my
$version_err
;
for
my
$release
(
@releases
) {
(
my
$version
=
$release
->version) =~ s/-TRIAL$//;
if
( not version::is_lax(
$version
) ) {
$version_err
=
$release
->version .
' (line '
.
$release
->line.
')'
;
last
;
}
}
$Test
->ok( !
defined
$version_err
,
"$file contains all valid release versions"
)
or
$Test
->diag(
' ERR: '
.
$version_err
),
$ok
= 0;
if
(
defined
$arg
->{version} ) {
my
$v
=
$arg
->{version};
my
$release
=
$changes
->release(
$v
);
if
(
$Test
->ok( !!
$release
,
"$file has an entry for version $v"
)) {
my
$entries
=
$release
->entries;
$Test
->ok( !!
@$entries
,
"$file version $v has content"
)
or
$ok
= 0;
}
else
{
$Test
->skip(
"can't check for entries in nonexistant version"
);
$ok
= 0;
};
}
return
!!
$ok
;
}
1;