add a 'git-gather' command

CHANGELOG.yml

@@ -0,0 +1,17 @@
+---
+project:
+  name: App::Changelord
+  homepage: https://git.babyl.ca/yanick/App-Changelord
+releases:
+  - version: ~
+    changes:
+      - Initial release
+change_types:
+  - feat:
+      level: minor
+      title: Features
+    keywords: []
+  - fix:
+      level: patch
+      title: Bug fixes
+    keywords: []

lib/App/Changelord.pm

@@ -33,7 +33,7 @@ sub run($self) {
     print $self->as_markdown;
 }
 
-subcommand $_ => 'App::Changelord::Command::' . ucfirst $_
+subcommand $_ => 'App::Changelord::Command::' . ucfirst $_ =~ s/-(.)/uc $1/er
-    for qw/ schema validate version bump init add/;
+    for qw/ schema validate version bump init add git-gather /;
 
 1;

lib/App/Changelord/Command/GitGather.pm

@@ -0,0 +1,130 @@
+package App::Changelord::Command::GitGather;
+
+use v5.36.0;
+
+use Moo;
+use CLI::Osprey
+    desc => 'gather changes from git commit messages',
+    description_pod => <<'END_POD';
+Inspects the git log of the current branch for commit
+messages looking like change entries. If any are found, add them to the
+changelog.
+
+=head2 Lower bound of the git log
+
+C<git-gather> will inspect the git log from the most recent of those
+three points:
+
+=over
+
+=item The last change in the NEXT release having a C<commit> property.
+
+=item The last tagged version.
+
+=item The beginning of time.
+
+=back
+
+=head2 Change-like git message
+
+Git messages are compared to the regular expression
+configured at `project.commit_regex`. If none is found, it
+defaults to
+
+    ^(?<type>[^:]+):(?<desc>.*?)(\[(?<ticket>[^\]]+)\])?$
+
+The regular expression must capture a C<desc> field, and may
+capture a C<type> and C<ticket> as well.
+
+END_POD
+
+use Path::Tiny;
+use Git::Repository;
+
+has changelog => ( is => 'lazy' );
+
+sub _build_changelog ($self) { $self->parent_command->changelog }
+
+with 'App::Changelord::Role::Versions';
+with 'App::Changelord::Role::ChangeTypes';
+
+has repo => (
+    is => 'ro',
+    default => sub { Git::Repository->new( work_tree => '.' ) },
+);
+
+has commit_regex => (
+    is => 'lazy'
+);
+
+sub _build_commit_regex($self) {
+    my $regex = $self->changelog->{project}{commit_regex};
+    my $default = '^(?<type>[^:]+):(?<desc>.*?)(\[(?<ticket>[^\]]+)\])?$';
+    if(!$regex) {
+        warn "project.commit_regex not configured, using the default /$default/\n";
+        $regex = $default;
+    }
+    return $regex;
+}
+
+sub lower_bound($self) {
+    # either the most recent commit in the current release
+    my @sha1s = grep { $_ } map { $_->{commit} } $self->next_release->{changes}->@*;
+
+    return pop @sha1s if @sha1s;
+
+    return $self->latest_version;
+}
+
+sub get_commits($self,$since=undef) {
+    return reverse $self->repo->run( 'log', '--pretty=format:%H %s', $since ? "$since.." : () );
+}
+
+sub munge_message($self,$message) {
+    my $regex = $self->commit_regex;
+
+    $message =~ s/(\S+) //;
+    my $commit = $1;
+
+    return () unless $message =~ qr/$regex/;
+
+    return { %+, commit => $commit };
+}
+
+sub save_changelog($self) {
+    my $src = $self->parent_command->source;
+
+    path($src)->spew( App::Changelord::Command::Init::serialize_changelog($self) );
+}
+
+sub run ($self) {
+
+    say "let's check those git logs...";
+
+    # figure out lower bound
+    my $from = $self->lower_bound;
+
+    say "checking from ", ( $from || 'the dawn of time' ), " on";
+
+    my @messages = map { $self->munge_message($_) } $self->get_commits($from);
+
+    unless(@messages) {
+        say "\nno change detected";
+        return;
+    }
+
+    print "\n";
+    say "  * ", $_->{desc} for @messages;
+    print "\n";
+
+    push $self->next_release->{changes}->@*, @messages;
+
+    $self->save_changelog;
+
+    say $self->parent_command->source, " updated";
+}
+
+1;
+
+__END__
+

lib/App/Changelord/Command/Init.pm

@@ -51,6 +51,7 @@ sub run ($self) {
             homepage => undef,
             with_stats => 'true',
             ticket_url => undef,
+            commit_regex => /^(?<type>[^:]+):(?<desc>.*?)(\[(?<ticket>[^\]]+)\])?$/,
         },
         change_types => $self->change_types,
         releases => [

lib/App/Changelord/Command/changelog-schema.yml

@@ -54,3 +54,4 @@ $defs:
       desc: { type: string }
       ticket: { type: [ string, 'null' ] }
       type: { type: [ string, 'null' ] }
+      commit: { type: [ string, 'null' ] }

lib/App/Changelord/Role/Versions.pm

@@ -36,4 +36,25 @@ sub next_version($self) {
     return $version->normal;
 }
 
+sub is_next($self,$release) {
+    my $version = $release->{version};
+    return !$version || $version eq 'NEXT';
+}
+
+sub next_release($self) {
+    my $changelog = $self->changelog;
+
+    my $release = $changelog->{releases}[0];
+
+    unless( $self->is_next($release) ) {
+        unshift $changelog->{releases}->@*,
+        $release = {
+            version => 'NEXT',
+            changes => [],
+        };
+    }
+
+    return $release;
+}
+
 1;