view release on metacpan or  search on metacpan

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

sub badge_block {
	return <<'__P4R_BADGE_INNER__';
__P4R_BADGE_INNER_BODY__
__P4R_BADGE_INNER__
}

sub run {
	my $readme = 'README.md';
	open my $fh, '<:encoding(UTF-8)', $readme
		or die "Cannot open README.md: $!";
	local $/;
	my $text = <$fh> // '';
	close $fh;

	$text = _strip_readme_badge_markdown_block($text);
	my $inner = badge_block();
	my $block = $inner . "\n\n";
	my $new_text = _insert_readme_badges_after_regen( $text, $block );
	return if $new_text eq $text;

	open my $out, '>:encoding(UTF-8)', $readme
		or die "Cannot write README.md: $!";
	print {$out} $new_text;
	close $out;
	return;
}

run() if !caller;

1;
P4R_INJECT_TMPL
}

sub _render_inject_readme_badges_pl {
	my ( $class, $inner ) = @_;
	$inner = '' unless defined $inner;
	my $marker = '__P4R_BADGE_INNER_BODY__';
	croak "inject-readme-badges.pl: badge text must not contain $marker"
		if index( $inner, $marker ) >= 0;
	my $t = $class->_inject_readme_badges_pl_template;
	my $i = index( $t, $marker );
	croak 'inject-readme-badges.pl: template missing inner placeholder'
		if $i < 0;
	substr( $t, $i, length($marker), $inner );
	return $t;
}

sub write_inject_readme_badges_script {
	my ( $class, $cwd, $inner, $verbose ) = @_;
	my $rel  = $class->inject_readme_badges_relpath;
	my @segs = split qr{/}, $rel;
	my $file = pop @segs;
	my $path = File::Spec->catfile( $cwd, @segs, $file );
	make_path( File::Spec->catfile( $cwd, @segs ) ) if @segs;

	my $text = $class->_render_inject_readme_badges_pl($inner);
	open my $out, '>:encoding(UTF-8)', $path
		or croak "Cannot write '$path': $!";
	print {$out} $text;
	close $out;
	chmod 0755, $path or warn "[prepare4release] chmod 0755 '$path': $!\n";
	warn "[prepare4release] wrote $rel (standalone README badge injector)\n"
		if $verbose;
	return;
}

# Makefile fragment: pod2* then inject README shields via generated script (no App::pm dep).
sub _postamble_block {
	my ( $class, $opts ) = @_;
	$opts = {} unless ref $opts eq 'HASH';
	my $tab = "\t";
	my $want_pod2github = $opts->{github} || $opts->{gitlab};
	my $pod_cmd         = $want_pod2github ? 'pod2github' : 'pod2markdown';
	my $inj             = $class->inject_readme_badges_relpath;

	return <<"EOF";
# BEGIN PREPARE4RELEASE_POSTAMBLE
sub MY::postamble {
  return '' if !-e '.git';
  <<'PREPARE4RELEASE_POD2README';
pure_all :: README.md

README.md : \$(VERSION_FROM)
${tab}$pod_cmd \$< \$@
${tab}\$(PERL) $inj
PREPARE4RELEASE_POD2README
}
# END PREPARE4RELEASE_POSTAMBLE
EOF
}

sub makefile_has_pod2github {
	my ( $class, $content ) = @_;
	return $content =~ /pod2github\b/;
}

sub makefile_has_pod2markdown {
	my ( $class, $content ) = @_;
	return $content =~ /pod2markdown\b/;
}

sub _replace_marked_postamble_block {
	my ( $class, $content, $new_block ) = @_;
	return $content
		unless $content =~ /^\# BEGIN PREPARE4RELEASE_POSTAMBLE/m;
	my $out = $content;
	# Line endings: require \r?\n so CRLF files (common on Windows / some editors)
	# still match; a strict \n-only pattern leaves the block unchanged and pod2*
	# never updates.
	# No /x: it would strip spaces in "# BEGIN ..." and treat # as comments. The pattern
	# must be a single line: multiline s{}{} would include literal \n\t from this file.
	$out =~ s/^\# BEGIN PREPARE4RELEASE_POSTAMBLE\s*\r?\n.*?^\# END PREPARE4RELEASE_POSTAMBLE\s*\r?\n?/$new_block/ms;
	return $out;
}

sub _replace_legacy_my_postamble_heredoc {
	my ( $class, $content, $new_block ) = @_;
	my $re = qr/
		^sub \s+ MY::postamble \s* \{
		[\s\S]*?
		<<'(?:POD2README|PREPARE4RELEASE_POD2README)'