don't always sort changelog entries

lib/MetaCPAN/Web/Model/API/Changes.pm

@@ -13,6 +13,49 @@ sub get {
     $self->request( '/changes/' . join( '/', @path ) );
 }
 
+sub _relevant_changes {
+    my ( $self, $content, $opts ) = @_;
+
+    my $version = _parse_version( $opts->{version} );
+
+    my @releases = _releases($content);
+
+    my @changelogs;
+
+    if ( _versions_cmp( $releases[-1]->{version_parsed}, $version ) == 0 ) {
+        @releases = reverse @releases;
+    }
+    elsif ( _versions_cmp( $releases[0]->{version_parsed}, $version ) == 0 ) {
+
+        # noop
+    }
+    else {
+        @releases = sort {
+            _versions_cmp( $b->{version_parsed}, $a->{version_parsed} )
+        } @releases;
+        if ( _versions_cmp( $releases[0]->{version_parsed}, $version ) != 0 )
+        {
+            @releases = ();
+        }
+    }
+
+    if (@releases) {
+        my $current = shift @releases;
+        $current->{current} = 1;
+        push @changelogs, $current;
+
+        if ( $opts->{include_dev} ) {
+            for my $dev_r (@releases) {
+                last
+                    if !$dev_r->{dev};
+                push @changelogs, $dev_r;
+            }
+        }
+    }
+
+    return \@changelogs;
+}
+
 sub release_changes {
     my ( $self, $path, %opts ) = @_;
     $path = join '/', @$path
@@ -23,27 +66,11 @@ sub release_changes {
         my $content = $file->{content}
             or return Future->done( { code => 404 } );
 
-        my $version
-            = _parse_version( $opts{version} || $file->{version} );
-
-        my @releases = _releases($content);
-
-        my @changelogs;
-        while ( my $r = shift @releases ) {
-            if ( _versions_cmp( $r->{version_parsed}, $version ) == 0 ) {
-                $r->{current} = 1;
-                push @changelogs, $r;
-                if ( $opts{include_dev} ) {
-                    for my $dev_r (@releases) {
-                        last
-                            if !$dev_r->{dev};
-                        push @changelogs, $dev_r;
-                    }
-                }
-            }
-        }
+        $opts{version} ||= $file->{version};
+
+        my $changes = $self->_relevant_changes( $content, \%opts );
         return Future->done( {
-            changes => \@changelogs,
+            changes => $changes,
         } );
     } );
 }
@@ -104,9 +131,8 @@ sub _releases {
     my $changelog
         = MetaCPAN::Web::Model::API::Changes::Parser->parse($content);
 
-    my @releases
-        = sort { _versions_cmp( $b->{version_parsed}, $a->{version_parsed} ) }
-        map {
+    my @releases = map {
+        ;
         my $v     = _parse_version( $_->{version} );
         my $trial = $_->{version} =~ /-TRIAL$/
             || $_->{note} && $_->{note} =~ /\bTRIAL\b/;
@@ -117,7 +143,7 @@ sub _releases {
             trial          => $trial,
             dev            => $dev,
         };
-        } @{ $changelog->{releases} || [] };
+    } @{ $changelog->{releases} || [] };
     return @releases;
 }
 

t/model/changes.t

@@ -4,8 +4,146 @@ use lib 't/lib';
 
 use Test::More;
 
-use aliased 'MetaCPAN::Web::Model::API::Changes';
+use MetaCPAN::Web ();
 
-ok 1;
+my $model = MetaCPAN::Web->model('API::Changes');
+
+my $changelog = <<'END_CHANGES';
+Prelude
+
+v1.3
+    - first change
+    - second change
+
+v1.2-TRIAL
+    - change from dev release
+
+v1.0
+    - change from old release
+
+v1.1-TRIAL
+    - change from unordered old dev release
+
+END_CHANGES
+
+{
+    my $changes = $model->_relevant_changes(
+        $changelog,
+        {
+            version => 'v1.3',
+        }
+    );
+
+    is @$changes,                1,      'got one release';
+    is $changes->[0]->{version}, 'v1.3', 'release is requested version';
+}
+{
+    my $changes = $model->_relevant_changes(
+        $changelog,
+        {
+            include_dev => 1,
+            version     => 'v1.3',
+        }
+    );
+
+    is @$changes,                2,      'got two releases including dev';
+    is $changes->[0]->{version}, 'v1.3', 'first release is requested version';
+    is $changes->[1]->{version}, 'v1.2-TRIAL',
+        'second release is dev release';
+}
+
+my $rev_changelog = <<'END_CHANGES';
+Prelude
+
+v1.1-TRIAL
+    - change from unordered old dev release
+
+v1.0
+    - change from old release
+
+v1.2-TRIAL
+    - change from dev release
+
+v1.3
+    - first change
+    - second change
+
+END_CHANGES
+
+{
+    my $changes = $model->_relevant_changes(
+        $rev_changelog,
+        {
+            version => 'v1.3',
+        }
+    );
+
+    is @$changes, 1, 'reversed: got one release';
+    is $changes->[0]->{version}, 'v1.3',
+        'reversed: release is requested version';
+}
+{
+    my $changes = $model->_relevant_changes(
+        $changelog,
+        {
+            include_dev => 1,
+            version     => 'v1.3',
+        }
+    );
+
+    is @$changes, 2, 'reversed: got two releases including dev';
+    is $changes->[0]->{version}, 'v1.3',
+        'reversed: first release is requested version';
+    is $changes->[1]->{version}, 'v1.2-TRIAL',
+        'reversed: second release is dev release';
+}
+
+my $scramble_changelog = <<'END_CHANGES';
+Prelude
+
+v1.0
+    - change from old release
+
+v1.3
+    - first change
+    - second change
+
+v1.1-TRIAL
+    - change from old dev release
+
+v1.2-TRIAL
+    - change from dev release
+
+END_CHANGES
+
+{
+    my $changes = $model->_relevant_changes(
+        $scramble_changelog,
+        {
+            version => 'v1.3',
+        }
+    );
+
+    is @$changes, 1, 'scrambled: got one release';
+    is $changes->[0]->{version}, 'v1.3',
+        'scrambled: release is requested version';
+}
+{
+    my $changes = $model->_relevant_changes(
+        $scramble_changelog,
+        {
+            include_dev => 1,
+            version     => 'v1.3',
+        }
+    );
+
+    is @$changes, 3, 'scrambled: got two releases including dev';
+    is $changes->[0]->{version}, 'v1.3',
+        'scrambled: first release is requested version';
+    is $changes->[1]->{version}, 'v1.2-TRIAL',
+        'scrambled: second release is dev release';
+    is $changes->[2]->{version}, 'v1.1-TRIAL',
+        'scrambled: third release is dev release';
+}
 
 done_testing;