# Copyright 2009, 2010, 2011, 2013 Kevin Ryde

# Perl-Critic-Pulp is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Perl-Critic-Pulp is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Perl-Critic-Pulp.  If not, see <http://www.gnu.org/licenses/>.


# use strict;
# $, = "\n";
# sub foo {
#   return 123;
# }
# sub x {
#     my %h = (-foo
#              => 'abc');
# print %h
#   }
# x();


package Perl::Critic::Policy::CodeLayout::ProhibitFatCommaNewline;
use 5.006;
use strict;
use warnings;
use Perl::Critic::Utils;

# 1.084 for Perl::Critic::Document highest_explicit_perl_version()
use Perl::Critic::Policy 1.084;
use base 'Perl::Critic::Policy';

our $VERSION = 79;

# uncomment this to run the ### lines
# use Smart::Comments;


use constant supported_parameters => ();
use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM;
use constant default_themes   => qw(pulp bugs);
use constant applies_to       => ('PPI::Token::Operator');

use version;
my $v5008 = version->new('5.008');

sub violates {
  my ($self, $elem, $document) = @_;

  $elem->content eq '=>'
    or return; # some other operator

  my $prev = $elem->sprevious_sibling || return;
  if (! $prev->isa('PPI::Token::Word')) {
    ### previous not a word, so => acts as a plain comma, ok ...
    return;
  }
  if (! _elems_any_newline_between ($prev, $elem)) {
    ### no newline before =>, ok ...
    return;
  }

  my $word = $prev->content;

  # A builtin is never quoted by newline fat comma.
  # PPI 1.213 gives a word "-print" where it should be a negate of a
  # print(), so check the word "sans dash".
  if (Perl::Critic::Utils::is_perl_builtin(_sans_dash($word))) {
    return $self->violation
      ("Fat comma after newline doesn't quote Perl builtin \"$word\"",
       '',
       $elem);
  }

  # In 5.8 up words are quoted by newline fat comma, so ok.
  if (defined (my $doc_version = $document->highest_explicit_perl_version)) {
    if ($doc_version >= $v5008) {
      return;
    }
  }

  # In 5.6 and earlier newline fat comma doesn't quote.
  return $self->violation
    ("Fat comma after newline doesn't quote preceding bareword \"$word\"",
     '',
     $elem);
}

# return $str stripped of a leading "-", if it has one
sub _sans_dash {
  my ($str) = @_;
  $str =~ s/^-//;
  return $str;
}

# $from and $to are PPI::Element
# Return true if there's a "\n" newline anywhere in between those elements,
# not including either $from or $to themselves.
sub _elems_any_newline_between {
  my ($from, $to) = @_;
  if ($from == $to) { return 0; }
  for (;;) {
    $from = $from->next_sibling || return 0;
    if ($from == $to) { return 0; }
    if ($from =~ /\n/) { return 1; }
  }
}

1;
__END__

=for stopwords Ryde bareword builtin Builtin builtins Builtins eg parens

=head1 NAME

Perl::Critic::Policy::CodeLayout::ProhibitFatCommaNewline - keep a fat comma on the same line as its quoted word

=head1 DESCRIPTION

This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
add-on.  It reports a newline between a fat comma and preceding bareword for
Perl builtins,

    my %h = (caller         # bad
             => 'abc');

And all words when targeting Perl 5.6 and earlier,

    use 5.006;
    my %h = (foo            # bad, all words in perl 5.6 and earlier
             => 'def');

When there's a newline between the word and the fat comma like this the word
executes as a function call (builtins always, user defined in 5.6 and
earlier), giving its return value rather than a word string.  Such a return
value is probably not what was intended and on that basis this policy is
under the "bugs" theme and medium severity (see L<Perl::Critic/POLICY
THEMES>).

=head2 Builtins

Perl builtin functions with a newline always execute and give their return
value rather than a the quoted word.

    my %h = (print          # bad, builtin print() executes
             => "abc");
    # %h is key "1" value "abc"

The builtin is called with no arguments and that might provoke a warning
from some, but others like C<print> will quietly run.

Dashed builtin names such as C<-print> are also function calls, with a
negate operator.

    my %h = (-print       # bad, "print" execute and negate result
             => "123");
    # h is key "-1" value "123"

For the purposes of this policy the builtins are C<is_perl_builtin()> from
L<Perl::Critic::Utils>.  It's possible this is more builtins than the
particular Perl in use, but guarding against all will help if going to a
newer Perl in the future.

=head2 Non-Builtins

In Perl 5.6 and earlier all words C<foo> execute as a function call when
there's a newline before the fat comma.

    sub foo {
      return 123
    }
    my %h = (foo
             => "def");
    # in Perl 5.6 and earlier %h is key "123" value "def"

Under C<use strict> an error is thrown if no such function, in the usual
way.  A word builtin is a function call if it exists (with a warning about
being interpreted that way), or a bareword if not.

This policy prohibits all words with newline before fat comma when targeting
Perl 5.6 or earlier.  This means either an explicit C<use 5.006> or smaller,
or no such minimum C<use> at all.

One subtle way an executing word with newline before fat comma can go
undetected (in 5.6 and earlier still) is an accidental redefinition of a
constant,

    use constant FOO => "blah";

    use constant FOO
      => "some value";

    # makes a constant subr called blah (in Perl 5.6)

C<constant.pm> might reject some return values from C<FOO()>, eg. a number,
but a string like "blah" here quietly expands and creates a constant
C<blah()>.

The difference between Perl 5.6 and later Perl is that in 5.6 the parser
only looked ahead as far as a newline for a possible quoting C<=E<gt>> fat
comma.  In Perl 5.8 and later the lookahead continues beyond any newlines
and comments.  For Perl builtins the behaviour is unchanged though, in all
versions the lookahead stops at the newline.

=head2 Avoiding Problems

Putting the fat comma on the same line as the word ensures it quotes in all
cases.

    my %h = (-print =>    # ok, fat comma on same line quotes
             "123");

If for layout purposes you do want a newline then the suggestion is to give
a string or perhaps a parenthesized expression since that doesn't rely on
the C<=E<gt>> fat comma quoting.  You can still use fat comma to emphasize a
key/value pair.

    my %h = ('print'      # ok, string
             =>
             123);

Alternately if instead a function call is really what's intended (builtin or
otherwise) then parens can be used in the normal way to ensure it's a call
(as per L<perltrap> the rule being "if it looks like a function, it is a
function").

    my %h = (foo()        # ok, function call
             =>
             123);

=head2 Disabling

As always if you don't care about this then you can disable
C<ProhibitFatCommaNewline> from your F<.perlcriticrc> in the usual
way (see L<Perl::Critic/CONFIGURATION>),

    [-CodeLayout::ProhibitFatCommaNewline]

=head1 SEE ALSO

L<Perl::Critic::Pulp>, L<Perl::Critic>, L<perlop>

=head1 HOME PAGE

http://user42.tuxfamily.org/perl-critic-pulp/index.html

=head1 COPYRIGHT

Copyright 2011, 2013 Kevin Ryde

Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

Perl-Critic-Pulp is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
more details.

You should have received a copy of the GNU General Public License along with
Perl-Critic-Pulp.  If not, see <http://www.gnu.org/licenses/>.

=cut
