view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/Git/CommitBuild.pm  view on Meta::CPAN

    isa     => Bool,
    default => 0,
);

# -- attribute builders

sub _build_release_message { return shift->message; }

# -- role implementation

around dump_config => sub
{
    my $orig = shift;
    my $self = shift;

    my $config = $self->$orig;

    $config->{+__PACKAGE__} = {
        (map +($_ => $self->$_),
            qw(branch release_branch message release_message build_root)),
        multiple_inheritance => $self->multiple_inheritance ? 1 : 0,
        blessed($self) ne __PACKAGE__ ? ( version => $VERSION ) : (),
    };

    return $config;
};

sub after_build {
    my ( $self, $args) = @_;

    # because the build_root mysteriously change at
    # the 'after_release' stage
    $self->build_root( $args->{build_root} );

    $self->_commit_build( $args, $self->branch, $self->message );
}

sub after_release {
    my ( $self, $args) = @_;

    $self->_commit_build( $args, $self->release_branch, $self->release_message );
}

sub _commit_build {
    my ( $self, undef, $branch, $message ) = @_;

    return unless $branch;

    my $dir = Path::Tiny->tempdir( CLEANUP => 1) ;
    my $src = $self->git;

    my $target_branch = _format_branch( $branch, $self );

    for my $file ( @{ $self->zilla->files } ) {
        my ( $name, $content ) = ( $file->name, (Dist::Zilla->VERSION < 5
                                                 ? $file->content
                                                 : $file->encoded_content) );
        my ( $outfile ) = $dir->child( $name );
        $outfile->parent->mkpath();
        $outfile->spew_raw( $content );
        chmod $file->mode, "$outfile" or die "couldn't chmod $outfile: $!";
    }

    # returns the sha1 of the created tree object
    my $tree = $self->_create_tree($src, $dir);

    my ($last_build_tree) = try { $src->rev_parse("$target_branch^{tree}") };
    $last_build_tree ||= 'none';

    ### $last_build_tree
    if ($tree eq $last_build_tree) {

        $self->log("No changes since the last build; not committing");
        return;
    }

    my @parents = (
        ( $self->_source_branch ) x $self->multiple_inheritance,
        grep
            eval { $src->rev_parse({ 'q' => 1, 'verify'=>1}, $_ ) },
        $target_branch
    );

    ### @parents

    my $this_message = _format_message( $message, $self );
    my @commit = $src->commit_tree( { -STDIN => $this_message }, $tree, map +( '-p' => $_), @parents );

    ### @commit
    $src->update_ref( 'refs/heads/' . $target_branch, $commit[0] );
}

sub _create_tree {
    my ($self, $repo, $fs_obj) = @_;

    ### called with: "$fs_obj"
    if (!$fs_obj->is_dir) {

        my ($sha) = $repo->hash_object({ w => 1 }, "$fs_obj");
        ### hashed: "$sha $fs_obj"
        return $sha;
    }

    my @entries;
    for my $obj ($fs_obj->children) {

        ### working on: "$obj"
        my $sha  = $self->_create_tree($repo, $obj);
        my $mode = sprintf('%o', $obj->stat->mode); # $obj->is_dir ? '040000' : '
        my $type = $obj->is_dir ? 'tree' : 'blob';
        my $name = $obj->basename;

        push @entries, "$mode $type $sha\t$name";
    }

    ### @entries

    my ($sha) = $repo->mktree({ -STDIN => join("\n", @entries, q{}) });

    return $sha;
}