view release on metacpan or  search on metacpan

bin/gitc-submit  view on Meta::CPAN

    fetch_tags(); 
    my @users = user_lookup_class()->users();

    return if any { $_ eq $reviewer } @users;

    # an invalid reviewer.  make some suggestions
    require Text::Levenshtein;
    require List::Util;
    my @suggestions =
        map  { $_->[0] }
        sort { $a->[1] <=> $b->[1] }
        grep { $_->[1] < 4 }           # only "close" matches
        map  { [ $_, scalar Text::Levenshtein::distance( $reviewer, $_ ) ] }
        @users;
    my @short_list = @suggestions[ 0 .. List::Util::min($#suggestions, 2) ];

    my $msg = "The user name '$reviewer' is invalid. ";
    if (@suggestions) {
        $msg   .= "Perhaps you meant one of:\n";
        $msg   .= "  - $_\n" for @short_list;
    }
    else {
        $msg .= "\n";
    }
    die $msg;
}

# Execute a rebase (and never return) if this changeset hasn't accounted
# for the most recent commits on its 'onto' branch.
sub launch_auto_rebase {
    my ($branch_point) = @_;

    # are there new commits since the changeset branch?
    my $basis = branch_basis($branch_point);
    return if $basis !~ /^(master|test|stage|prod)$/;
    my @upstream = git "rev-list --first-parent origin/$basis ^HEAD";
    return if not @upstream;

    # yup, so start a rebase
    my $count = @upstream;
    my $s = $count == 1 ? '' : 's';
    warn "Uh oh, $basis has $count commit$s since you started.\n"
        . "I'm rebasing for you.  When it's done, resubmit.\n"
        . "\n"
        ;
    exec "git rebase --onto origin/$basis $branch_point";
}

sub export_patches {
    my ($changeset) = @_;

    # generate the patches
    require File::Temp;
    my $tmpdir = File::Temp::tempdir(
        'gitc-submit-XXXXX',
        TMPDIR  => 1,
        CLEANUP => 1,
    );
    my $project = project_name();
    git "format-patch -o $tmpdir"
      . "             --thread"
      . "             --no-numbered"
      . "             --cover-letter"
      . "             --no-color"
      . "             --no-binary"
      . "             -M -C --no-ext-diff"
      . "             --no-prefix"
      . "             --subject-prefix='$project#$changeset'"
      . "             " . branch_point($changeset)
      ;

    # CONFIGURE (optional)
    # Add any local custom headers to the call above 
    # TODO This should be pulled in from a configuration file

    # adjust the cover-letter subject line
    my @patches = glob("$tmpdir/*.patch");
    if ( @patches > 2 and $its ) {
        fill_in_subject_line($tmpdir, $changeset);
        return ( $tmpdir, "$tmpdir/0000-cover-letter.patch" );
    }

    # there's only one real patch, so send it
    unlink "$tmpdir/0000-cover-letter.patch";
    my ($patch) = glob("$tmpdir/*.patch");
    if ($its) {
        my $uri = $its->issue_changeset_uri( $its->get_issue($changeset) );
        if ($uri) {
            my $content = do {
                open my $fh, '<', $patch or die "Couldn't open $patch: $!";
                local $/;
                <$fh>;
            };
            $content =~ s{\n\n}{\n\n$uri\n\n};
            open my $fh, '>', $patch or die "Couldn't write to $patch: $!";
            print $fh $content;
        }
    }
    return ( $tmpdir, $patch );
}

sub fill_in_subject_line {
    my ($tmpdir, $changeset) = @_;
    my $file = "$tmpdir/0000-cover-letter.patch";

    # read in the current cover letter
    open my $fh, '<', $file or die "Couldn't read cover letter : $?";
    my $content = do { local $/; <$fh> };
    close $fh;

    # replace the default subject line
    my $its_name = $its->label_service;
    my $its_label = $its->label_issue;
    my $issue = $its->get_issue($changeset);
    my $subject = eval {
        print STDERR "Looking for $its_name $its_label...";
        my $summary = $its->issue_summary($issue);
        print STDERR "done\n";
        return $summary;
    } || "Submitted for Review";
    warn "Problem obtaining the $its_label summary: $@" if $issue and $@;