view release on metacpan or  search on metacpan

lib/App/GitHooks/Plugin/PgBouncerAuthSyntax.pm  view on Meta::CPAN

	# Ignore deleted files.
	return $PLUGIN_RETURN_SKIPPED
			if $git_action eq 'D';

	# Determine which setting to use for comments.
	my $comments_setting = $config->get( 'PgBouncerAuthSyntax', 'comments_setting' );
	croak '"comments_setting" needs to be defined in the [PgBouncerAuthSyntax] section of your .githooksrc file'
		if !defined( $comments_setting ) || ( $comments_setting eq '' );
	croak 'The value of "comments_setting" in the [PgBouncerAuthSyntax] section of your .githooksrc file is not valid'
		if $comments_setting !~ /^(?:allow_anywhere|allow_end_only|disallow)$/x;

	# Retrieve lines.
	my @lines = File::Slurp::read_file( $repository->work_tree() . '/' . $file );

	# Find the incorrectly formatted lines.
	my @issues = ();
	my $comments_detected = 0;
	for ( my $i = 0; $i < scalar( @lines ); $i++ )
	{
		my $line = $lines[ $i ];

		# Skip blank lines.
		next
			if !defined( $line ) || ( $line eq '' );

		# Handle comments.
		if ( substr( $line, 0, 1 ) eq ';' )
		{
			$comments_detected = 1;

			# If we don't allow comments, note the error before moving on to the next
			# line.
			if ( $comments_setting eq 'disallow' )
			{
				push(
					@issues,
					{
						line_number => $i,
						line        => $line,
					}
				);
			}

			next;
		}
		if ( $comments_detected && ( $comments_setting eq 'allow_end_only' ) )
		{
			# This line is not a comment, but comment lines have already been seen
			# and we only allow comments at the end of the file.
			push(
				@issues,
				{
					line_number => $i,
					line        => $line,
				}
			);
			next;
		}

		# Skip lines with the correct username/password specification.
		next
			if $line =~ /
					^
					"[^"]*"   # Username.
					\         # Space.
					"[^"]*"   # Password.
					(?:\ .*)? # Remainder of the line, no specific format required except
					          # for a space if anything follows.
					$
				/x;

		push(
			@issues,
			{
				line_number => $i,
				line        => $line,
			}
		);
	}

	die "Incorrectly formatted lines:\n" . join( '', map { "Line $_->{'line_number'}: $_->{'line'}" } @issues ) . "\n"
		if scalar( @issues ) != 0;

	return $PLUGIN_RETURN_PASSED;
}


=head1 BUGS

Please report any bugs or feature requests through the web interface at
L<https://github.com/guillaumeaubert/App-GitHooks-Plugin-PgBouncerAuthSyntax/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::Plugin::PgBouncerAuthSyntax


You can also look for information at:

=over

=item * GitHub's request tracker

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

=item * AnnoCPAN: Annotated CPAN documentation

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

=item * CPAN Ratings

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

=item * MetaCPAN