App-Changelord

 view release on metacpan or  search on metacpan

lib/App/Changelord.pm  view on Meta::CPAN

use Moo;
use CLI::Osprey
    desc => 'changelog manager';

use YAML;

use List::AllUtils qw/ pairmap partition_by /;

use App::Changelord::Role::ChangeTypes;

sub run($self) {
    App::Changelord::Command::Print->new(
        parent_command => $self,
    )->run;
}

subcommand $_ => 'App::Changelord::Command::' . ucfirst $_ =~ s/-(.)/uc $1/er
    for qw/ schema validate version bump init add git-gather print /;

1;

lib/App/Changelord/Command/Add.pm  view on Meta::CPAN

    doc => 'type of change',
    is => 'ro',
);

option ticket => (
    format => 's',
    doc => 'associated ticket',
    is => 'ro',
);

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;
}

sub save_changelog($self) {
    my $src = $self->source;

    path($src)->spew( App::Changelord::Command::Init::serialize_changelog($self) );
}

sub run ($self) {
    my $version = $self->next_release;

    push $version->{changes}->@*, {
        maybe type => $self->type,

lib/App/Changelord/Command/GitGather.pm  view on Meta::CPAN

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} } grep { ref } $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->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

lib/App/Changelord/Command/Init.pm  view on Meta::CPAN

use Path::Tiny;
use JSON;
use YAML           qw/ Bless /;
use List::AllUtils qw/ first min uniq /;
use Version::Dotted::Semantic;

with 'App::Changelord::Role::ChangeTypes';
with 'App::Changelord::Role::Changelog';
with 'App::Changelord::Role::Versions';

sub serialize_changelog($self, $changelog = undef) {

    $changelog //= $self->changelog;

    Bless($changelog)->keys(
        [   uniq qw/
              project releases change_types
              /, sort keys %$changelog
        ] );
    Bless( $changelog->{project} )->keys(
        [   uniq qw/

lib/App/Changelord/Command/Print.pm  view on Meta::CPAN

    doc => 'output schema as json',
);

option next => (
    is => 'ro',
    default => 1,
    negatable => 1,
    doc => 'include the NEXT release. Defaults to true.',
);

sub run($self) {
    no warnings 'utf8';
    print $self->as_markdown( $self->next );
}

'end of App::Changelog::Command::Print';

__END__

=pod

lib/App/Changelord/Command/Schema.pm  view on Meta::CPAN

use Path::Tiny;
use JSON;
use YAML;

option json => (
    is => 'ro',
    default => 0,
    doc => 'output schema as json',
);

sub run($self) {

    my $schema = YAML::Load(path(__FILE__)->sibling('changelog-schema.yml')->slurp);

    print $self->json ? JSON->new->pretty->encode(YAML::Load($schema)) : YAML::Dump($schema);
}

'end of App::Changelog::Command::Schema';

__END__

lib/App/Changelord/Command/Validate.pm  view on Meta::CPAN

use JSON::Schema::Modern;

with 'App::Changelord::Role::Changelog';

option json => (
    is => 'ro',
    default => 0,
    doc => 'output schema as json',
);

sub run($self) {
    local $YAML::XS::Boolean = 'boolean';

    my $schema = path(__FILE__)->sibling('changelog-schema.yml')->slurp;

    my $result = JSON::Schema::Modern->new(
        output_format => 'detailed',
    )->evaluate(
        $self->changelog,
        YAML::XS::Load($schema),
    );

lib/App/Changelord/Command/Version.pm  view on Meta::CPAN

use Path::Tiny;
use JSON;
use YAML::XS;
use List::AllUtils qw/ first min /;
use Version::Dotted::Semantic;

with 'App::Changelord::Role::Changelog';
with 'App::Changelord::Role::ChangeTypes';
with 'App::Changelord::Role::Versions';

sub run($self) {
    my $param  = shift @ARGV;

    die "invalid parameter '$param', needs to be nothing, 'next' or 'latest'\n"
        if $param and not  grep { $param eq $_ } qw/ next latest /;

        if(!$param) {
            say "latest version: ", $self->latest_version;
            say "next version:   ", $self->next_version;
        }
        elsif( $param eq 'next' ) {

lib/App/Changelord/Role/ChangeTypes.pm  view on Meta::CPAN

use v5.36.0;

use Moo::Role;

use feature 'try';

has change_types => (
    is => 'lazy',
);

sub _build_change_types($self) {
    no warnings;
    return eval {
        $self->changelog->{change_types};
    } || [
            { title => 'Features'  , level => 'minor', keywords => [ 'feat' ] } ,
            { title => 'Bug fixes' , level => 'patch', keywords => [ 'fix' ]  },
            { title => 'Package maintenance' , level => 'patch', keywords => [ 'chore', 'maint', 'refactor' ]  },
            { title => 'Statistics' , level => 'patch', keywords => [ 'stats' ]  },
        ]
}

lib/App/Changelord/Role/Changelog.pm  view on Meta::CPAN

option source => (
    is => 'ro',
    format => 's',
    doc => q{changelog yaml file. Defaults to the env variable $CHANGELOG, or 'CHANGELOG.yml'},
    default => $ENV{CHANGELOG} || 'CHANGELOG.yml',
);

has changelog => ( is => 'lazy' );

sub _build_changelog($self) {
    return YAML::LoadFile($self->source)
}

1;

__END__

=pod

=encoding UTF-8

lib/App/Changelord/Role/Stats.pm  view on Meta::CPAN

has stats => (
    is => 'lazy' );

sub _build_stats ($self) {
    my $comparison_data = $self->_get_comparison_data or return;

        my $stats = 'code churn: ' . $comparison_data;
        return $stats =~ s/\s+/ /gr;
}

sub _get_comparison_data($self) {

    # HEAD versus previous release
    # What are we diffing against? :)
    my $previous = $self->changelog->{releases}->@* > 1
        ? $self->changelog->{releases}[1]{version}
        : '4b825dc642cb6eb9a060e54bf8d69288fbee4904'; # empty tree

    my $output = eval {
            $self->repo->run( 'diff', '--shortstat', $previous, 'HEAD')
        };

lib/App/Changelord/Role/Versions.pm  view on Meta::CPAN

use List::AllUtils qw/ first min /;
use Version::Dotted::Semantic;

use Moo::Role;

use feature 'try';

requires 'changelog';

sub latest_version($self){
    first { $_ } grep { $_ ne 'NEXT' } map { eval { $_->{version} || '' } } $self->changelog->{releases}->@*, { version => 'v0.0.0' };
}

sub next_version($self) {
    my $version = Version::Dotted::Semantic->new($self->latest_version // '0.0.0');

    my $upcoming = $self->changelog->{releases}[0];

    if( $upcoming->{version} and $upcoming->{version} ne 'NEXT') {
        $upcoming = { changes => [] };
    }

    my %mapping = map {
        my $level = $_->{level};

lib/App/Changelord/Role/Versions.pm  view on Meta::CPAN

    no warnings;
    my $bump =min 2, map { $_ eq 'major' ? 0 : $_ eq 'minor' ? 1 : 2 } map { $mapping{$_->{type}} || 'patch' }
    map { ref ? $_ : { desc => $_ } }
    $upcoming->{changes}->@*;

    $version->bump($bump);

    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 => [],
        };