view release on metacpan or  search on metacpan

lib/App/GitHooks/Utils.pm  view on Meta::CPAN

=head2 get_ticket_id_from_branch_name()

Return the ticket ID derived from the name of the current branch for this
repository.

	my $ticket_id = App::GitHooks::Utils::get_ticket_id_from_branch_name( $app );

Arguments:

=over 4

=item * $app

An C<App::GitHooks> instance.

=back

=cut

sub get_ticket_id_from_branch_name
{
	my ( $app ) = @_;
	my $repository = $app->get_repository();
	my $config = $app->get_config();

	# If the config doesn't specify a way to extract the ticket ID from the
	# branch, there's nothing we can do here.
	my $ticket_regex = $config->get_regex( '_', 'extract_ticket_id_from_branch' );
	return undef
		if !defined( $ticket_regex );

	# Check if we're in a rebase. During a rebase (regardless of whether it's
	# interractive or not), the HEAD goes in a detached state, and we won't be
	# able to call symbolic-ref on it to get a branch name.
	my $git_directory = $repository->git_dir();
	return undef
		if ( -d File::Spec->catfile( $git_directory, 'rebase-merge' ) ) # detect rebase -i
			|| ( -d File::Spec->catfile( $git_directory, 'rebase-apply' ) ); # detect rebase

	my $ticket_id;
	try
	{

		# Retrieve the branch name.
		my $branch_name = $repository->run('symbolic-ref', 'HEAD');
		my ( $branch_name_without_prefixes ) = $branch_name =~ /([^\/]+)$/;

		# Extract the ticket ID from the branch name.
		my $project_prefix_regex = get_project_prefix_regex( $app );
		$ticket_regex =~ s/\$project_prefixes/$project_prefix_regex/g;
		( $ticket_id ) = $branch_name_without_prefixes =~ /$ticket_regex/i;

		my $normalize = $config->get( '_', 'normalize_branch_ticket_id' );
		if ( defined( $ticket_id ) && defined( $normalize ) && ( $normalize =~ /\S/ ) )
		{
			my ( $match, $replacement ) = $normalize =~ m|^\s*s/(.*?)(?<!\\)/(.*)/\s*|x;
			croak "Invalid format for 'normalize_branch_ticket_id' in configuration file."
				if !defined( $match ) || !defined( $replacement );
			croak "Unsafe matching pattern in 'normalize_branch_ticket_id', escape your slashes"
				if $match =~ /(?<!\\)\//;
			croak "Unsafe replacement pattern in 'normalize_branch_ticket_id', escape your slashes"
				if $replacement =~ /(?<!\\)\//;
			eval( "\$ticket_id =~ s/$match/$replacement/i" ); ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval)
		}
	}
	catch
	{
		carp "ERROR: $_";
	};

	return $ticket_id;
}


=head1 BUGS

Please report any bugs or feature requests through the web interface at
L<https://github.com/guillaumeaubert/App-GitHooks/issues/new>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

	perldoc App::GitHooks::Utils


You can also look for information at:

=over

=item * GitHub's request tracker

L<https://github.com/guillaumeaubert/App-GitHooks/issues>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/app-githooks>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/app-githooks>

=item * MetaCPAN

L<https://metacpan.org/release/App-GitHooks>

=back


=head1 AUTHOR

L<Guillaume Aubert|https://metacpan.org/author/AUBERTG>,
C<< <aubertg at cpan.org> >>.


=head1 COPYRIGHT & LICENSE

Copyright 2013-2017 Guillaume Aubert.