view release on metacpan or  search on metacpan

bin/gitc-promote  view on Meta::CPAN

    # extract structure from the command line
    my $target = pop @argv;
    my @changesets = grep { !/^-/ } @argv;

    # validate the promotion target
    die "You must specify a promotion target\n" if not $target;
    die "Invalid promotion target '$target'\n"
        if not defined environment_preceding($target);

    # validate changesets
    my $refs = validate_changesets( $target, @changesets );
    return ( $target, $refs, \@changesets );
}

# checks a list of changeset names for sanity. dies on anything bad.
# if the changesets are ok, it returns an arrayref of Git refs for
# those changesets
sub validate_changesets {
    my ( $target, @changesets ) = @_;
    return ( $target, [] ) if not @changesets;
    die "You may not cherry pick promote to prod\n"
        if !$force and $target eq 'prod' and @changesets;

    warn "Validating changesets\n";
    my @refs;
    my @already_promoted;
    my %seen;
    for my $changeset (@changesets) {
        die "You may not cherry pick '$changeset' to $target\n"
            if $changeset =~ m/^(master|test|stage|prod)$/;
        die   "You asked to promote '$changeset' twice.  Did you mean\n"
            . "to list it once or did you mistype some other changeset?\n"
            if $seen{$changeset}++;
        push @refs, full_changeset_name($changeset);
        push @already_promoted, $changeset
            if is_valid_ref("cs/$changeset/to-$target");
    }
    if (@already_promoted) {
        my $msg = "These changesets have already been promoted to $target:\n";
        $msg .= "  - $_\n" for @already_promoted;
        die $msg;
    }
    return \@refs;
}

# quickly locate any changeset dependencies that were not explicitly listed.
# takes a promotion target and a list of refs to promote.
# returns a list of the refs for those dependencies
sub find_missing_dependencies {
    my ( $target, @wanted ) = @_;
    my @extras = map { full_changeset_name($_) }
        unpromoted( \@wanted, "origin/$target" );

    # find refs that weren't explicitly listed
    my %extras = map { ( $_ => 1 ) } @extras;
    delete @extras{@wanted};
    return keys %extras;
}

# given a list of requested changeset refs and a list of missing dependency
# refs, prompts the user what to do and returns a new list of requested
# changeset refs
sub handle_missing_dependencies {
    my ( $wanted, $missing ) = @_;

    my @pretty = map { short_ref_name($_) } @$missing;
    sort_changesets_by_name(\@pretty);
    warn "The following changeset dependencies are missing:\n";
    warn "  - $_\n" for @pretty;
    die "Exiting promotion because of missing dependencies\n" if not -t STDIN;
    print STDERR 'What do you want to do? '
        . '(p)romote these too, e(x)it, see (d)etails: ';
    chomp ( my $choice = <STDIN> );
    if ( $choice eq 'p' ) {
        return ( @$wanted, @$missing );
    }
    elsif ( $choice eq 'd' ) {
        warn "\n";
        my $dep = build_ref_dependency_tree( $wanted, { select => 1 } );
        for my $ref (@$wanted) {
            my @also = map { short_ref_name($_) } @{ $dep->depends($ref) };
            next if not @also;
            warn '  '
                . short_ref_name($ref)
                . ' --> '
                . join( ', ', @also ) . "\n";
        }
        die "\nPlease change the promotion list and try again\n";
    }

    die "Exiting promotion because of missing dependencies\n";
}

# given an arrayref of wanted refs, returns an Algorithm::Dependency::Ordered
# object representing all the dependencies.
sub build_ref_dependency_tree {
    my ( $wanted, $args ) = @_;
    our $target;

    warn "Calculating changeset dependency tree\n";
    my %dependencies;
    my @outstanding_refs = @$wanted;
    while ( my $ref = shift @outstanding_refs ) {
        next if $dependencies{$ref};
        my @refs =
            grep { $_ ne $ref }
            map  { full_changeset_name($_) }
            unpromoted( $ref, "origin/$target" );
        push @outstanding_refs, @refs;
        $dependencies{$ref} = [ @refs ];  # copy the list of dependencies
    }

    # build the object
    require Algorithm::Dependency::Ordered;
    require Algorithm::Dependency::Source::HoA;
    my $source = Algorithm::Dependency::Source::HoA->new(\%dependencies);
    return Algorithm::Dependency::Ordered->new(
        source   => $source,
        $args->{select} ? ( selected => $wanted ) : (),
    );
}