# Copyright 2009, 2010, 2011 Kevin Ryde

# This file is part of Pod-MinimumVersion.

# Pod-MinimumVersion 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.
#
# Pod-MinimumVersion 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 Pod-MinimumVersion.  If not, see <http://www.gnu.org/licenses/>.


package Pod::MinimumVersion;
use 5.004;
use strict;
use List::Util;
use version;
use vars qw($VERSION @CHECKS);

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

$VERSION = 50;

sub new {
  my ($class, %self) = @_;
  $self{'want_reports'} ||= 'one_per_version';
  return bless \%self, $class;
}

sub minimum_version {
  my ($self) = @_;
  my $report = $self->minimum_report || return undef;
  return $report->{'version'};
}
sub minimum_report {
  my ($self) = @_;
  if (! exists $self->{'minimum_report'}) {
    $self->{'minimum_report'}
      = List::Util::reduce {$a->{'version'} > $b->{'version'} ? $a : $b}
        $self->reports;
  }
  return $self->{'minimum_report'};
}
sub reports {
  my ($self) = @_;
  $self->analyze;
  return @{$self->{'reports'} || []};
}

sub analyze {
  my ($self) = @_;
  return if $self->{'analyzed'};
  $self->{'analyzed'} = 1;

  ### Pod-MinVer analyze()

  my %checks;
  foreach my $elem (@CHECKS) {
    my ($func, $command, $version) = @$elem;
    next if ($self->{'above_version'} && $version <= $self->{'above_version'});
    push @{$checks{$command}}, $func;
  }
  return if (! %checks);

  require Pod::MinimumVersion::Parser;
  my $parser = Pod::MinimumVersion::Parser->new (pmv    => $self,
                                                 checks => \%checks);
  if (exists $self->{'string'}) {
    $parser->parse_from_string ("$self->{'string'}");
  } elsif (exists $self->{'filehandle'}) {
    $parser->parse_from_filehandle ($self->{'filehandle'});
  } elsif (exists $self->{'filename'}) {
    # stringize to parse_from_file() taking an overloaded object to be a handle
    # ENHANCE-ME: perhaps opening here and parse_from_filehandle() would be
    # a better way to avoid 
    $parser->parse_from_file ("$self->{'filename'}");
  }
}

#------------------------------------------------------------------------------
# 5.004
#
# E<> newly documented in 5.004, but is in pod2man right back to 5.002, so
# don't report that

{
  my $v5004 = version->new('5.004');

  # =for, =begin, =end new in 5.004
  #
  push @CHECKS, [ \&_check_for_begin_end, 'command', $v5004 ];
  my %for_begin_end = (for => 1, begin => 1, end => 1);
  sub _check_for_begin_end {
    my ($self, $command, $text, $para_obj) = @_;
    if ($for_begin_end{$command}) {
      $self->report ('for_begin_end', $v5004, $para_obj, "=$command command");
    }
  }
}

#------------------------------------------------------------------------------
# 5.005

{
  my $v5005 = version->new('5.005');

  # L<display|target> display alternative new in 5.005
  #
  push @CHECKS, [ \&_check_link_display_text, 'interior_sequence', $v5005 ];
  sub _check_link_display_text {
    my ($self, $command, $arg, $seq_obj) = @_;
    if ($command eq 'L' && $arg =~ /\|/) {
      $self->report ('link_display_text', $v5005, $seq_obj,
                     'Display text L<display|target> link');
    }
  }
}

#------------------------------------------------------------------------------
# 5.006

{
  my $v5006 = version->new('5.006');

  push @CHECKS, [ \&_check_double_angles, 'interior_sequence', $v5006 ];
  sub _check_double_angles {
    my ($self, $command, $arg, $seq_obj) = @_;

    if ($seq_obj->left_delimiter =~ /^<</) {
      $self->report ('double_angles', $v5006, $seq_obj,
                     'Double angle brackets C<< foo >>');
    }
  }
}

#------------------------------------------------------------------------------
# 5.008

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

  # =head3 and =head4 new in 5.8.0
  push @CHECKS, [ \&_check_head34, 'command', $v5008 ];
  my %head34 = (head3 => 1, head4 => 1);
  sub _check_head34 {
    my ($self, $command, $text, $para_obj) = @_;
    if ($head34{$command}) {
      $self->report ('head34', $v5008, $para_obj, "=$command command");
    }
  }

  # E<sol> and E<verbar> documented in 5.6.0, but Pod::Man only has them in
  # 5.8.0, so rate them as a 5008 feature
  #
  # E<apos> is in Pod::Man of 5.8.0, though not documented explicitly
  #
  push @CHECKS, [ \&_check_E_5008, 'interior_sequence', $v5008 ];
  my %E_5008 = (apos => 1, sol => 1, verbar => 1);
  sub _check_E_5008 {
    my ($self, $command, $arg, $seq_obj) = @_;

    if ($command eq 'E' && $E_5008{$arg}) {
      $self->report ('E_5008', $v5008, $seq_obj, "E<$arg> escape");
    }
  }

  # L<http://...> urls new in 5.8.0
  #
  # In 5.6 and earlier the "/" is interpreted as a section, so from
  # L<http://foo.com/index.html> you get something bad like
  #
  #    the section on "/foo.com/index.html" in the http: manpage
  #
  # Crib note: a "|" display text part is not allowed with a url, according
  # to perlpodspec of perl 5.10.0 under the "Authors wanting to link to a
  # particular (absolute) URL" bullet point.  So no need to watch for that
  # in applying this test.
  #
  push @CHECKS, [ \&_check_link_url, 'interior_sequence', $v5008 ];
  sub _check_link_url {
    my ($self, $command, $arg, $seq_obj) = @_;
    # this regexp as recommended by perlpodspec of perl 5.10.0
    if ($command eq 'L' && $arg =~ m/\A\w+:[^:\s]\S*\z/) {
      $self->report ('link_url', $v5008, $seq_obj,
                     'L<> link to URL');
    }
  }
}

#------------------------------------------------------------------------------
# 5.010

{
  my $v5010 = version->new('5.010');

  # =encoding documented in 5.8.0, but Pod::Man doesn't recognise it until
  # 5.10.0, so rate it as a 5010 feature
  #
  push @CHECKS, [ \&_check_encoding, 'command', $v5010 ];
  sub _check_encoding {
    my ($self, $command, $text, $para_obj) = @_;
    if ($command eq 'encoding') {
      $self->report ('encoding', $v5010, $para_obj, '=encoding command');
    }
  }
}

#------------------------------------------------------------------------------
# 5.012

{
  my $v5012 = version->new('5.012');

  # L<text|url> documented in 5.12.0 where previously explicitly prohibited,
  # rate it as a 5012 feature
  #
  push @CHECKS, [ \&_check_link_url_with_text, 'interior_sequence', $v5012 ];
  sub _check_link_url_with_text {
    my ($self, $command, $arg, $seq_obj) = @_;
    # this regexp adapted from recommendation of perlpodspec from perl 5.10.0
    if ($command eq 'L' && $arg =~ m/\A.*\|\w+:[^:\s]\S*\z/) {
      $self->report ('link_url_with_text', $v5012, $seq_obj,
                     'L<> link with URL and text');
    }
  }
}

#------------------------------------------------------------------------------

sub report {
  my ($self, $name, $version, $pod_obj, $why) = @_;

  if ($self->{'want_reports'} eq 'one_per_check') {
    return if ($self->{'seen'}->{$name}++);
  }
  if ($self->{'want_reports'} eq 'one_per_version') {
    return if ($self->{'seen'}->{$version}++);
  }

  my ($filename, $linenum) = $pod_obj->file_line;
  if (defined $self->{'filename'}) {
    $filename = $self->{'filename'};
  }
  require Pod::MinimumVersion::Report;
  push @{$self->{'reports'}},
    Pod::MinimumVersion::Report->new (filename => $filename,
                                      name     => $name,
                                      linenum  => $linenum,
                                      version  => $version,
                                      why      => $why);
}

1;
__END__

=for stopwords Ryde Pod-MinimumVersion

=head1 NAME

Pod::MinimumVersion - Perl version for POD directives used

=head1 SYNOPSIS

 use Pod::MinimumVersion;
 my $pmv = Pod::MinimumVersion->new (filename => '/some/foo.pl');
 print $pmv->minimum_version,"\n";
 print $pmv->reports;

=head1 DESCRIPTION

C<Pod::MinimumVersion> parses the POD in a Perl script, module, or document,
and reports what version of Perl is required to process the directives in
it with C<pod2man> etc.

=head1 CHECKS

The following POD features are identified.

=over 4

=item *

5.004: new C<=for>, C<=begin> and C<=end>

=item *

5.005: new LE<lt>display text|targetE<gt> style display part

=item *

5.6.0: new CE<lt>E<lt> foo E<gt>E<gt> etc double-angles

=item *

5.8.0: new C<=head3> and C<=head4>

=item *

5.8.0: new LE<lt>http://some.where.comE<gt> URLs.  (Before 5.8 the "/" is a
"section" separator, giving very poor output.)

=item *

5.8.0: new EE<lt>aposE<gt>, EE<lt>solE<gt>, EE<lt>verbarE<gt> chars.
(Documented in 5.6.0, but pod2man doesn't recognise them until 5.8.)

=item *

5.10.0: new C<=encoding> command.  (Documented in 5.8.0, but C<pod2man>
doesn't recognise it until 5.10.)

=item *

5.12.0: new LE<lt>display text|http://some.where.comE<gt> URL with text.
(Before 5.12 the combination of display part and URL was explicitly
disallowed by L<perlpodspec>.)

=back

POD syntax errors are quietly ignored currently.  The intention is only to
check what C<pod2man> would act on but it's probably a good idea to use
C<Pod::Checker> first.

S<C<JE<lt>E<lt> E<gt>E<gt>>> for C<Pod::MultiLang> is recognised and is
allowed for any Perl, including with double-angles.  The assumption is that
if you're writing that then you'll first crunch with the C<Pod::MultiLang>
tools, so it's not important what C<pod2man> thinks of it.

=head1 FUNCTIONS

=over 4

=item C<$pmv = Pod::MinimumVersion-E<gt>new (key =E<gt> value, ...)>

Create and return a new C<Pod::MinimumVersion> object which will analyze a
document.  The document is supplied as one of

    filehandle => $fh,
    string     => 'something',
    filename   => '/my/dir/foo.pod',

For C<filehandle> and C<string>, a C<filename> can be supplied too to give a
name in the reports.  The handle or string is what's actually read.

The C<above_version> option lets you set a Perl version of you have or are
targeting, so reports are only about features above that level.

    above_version => '5.006',

=item C<$version = $pmv-E<gt>minimum_version ()>

=item C<$report = $pmv-E<gt>minimum_report ()>

Return the minimum Perl required for the document in C<$pmv>.

C<minimum_version> returns a C<version> number object (see L<version>).
C<minimum_report> returns a C<Pod::MinimumVersion::Report> object (see
L</REPORT OBJECTS> below).

=item C<@reports = $pmv-E<gt>reports ()>

Return a list of C<Pod::MinimumVersion::Report> objects concerning the
document in C<$pmv>.

These multiple reports let you identify multiple places that a particular
Perl is required.  With the C<above_version> option the reports are only
about things higher than that.

C<minimum_version> and C<minimum_report> are simply the highest Perl among
these multiple reports.

=back

=head1 REPORT OBJECTS

A C<Pod::MinimumVersion::Report> object holds a location within a document
and a reason that a particular Perl is needed at that point.  The hash
fields are

    filename   string
    linenum    integer, with 1 for the first line
    version    version.pm object
    why        string

=over 4

=item C<$str = $report-E<gt>as_string>

Return a formatted string for the report.  Currently this is in GNU
file:line style, simply

    <filename>:<linenum>: <version> due to <why>

=back

=head1 SEE ALSO

L<version>,
L<Pod::MultiLang>,
L<Perl::Critic::Policy::Compatibility::PodMinimumVersion>

L<Perl::MinimumVersion>,
L<Perl::Critic::Policy::Modules::PerlMinimumVersion>,
L<Perl::Critic::Policy::Compatibility::PerlMinimumVersionAndWhy>

=head1 HOME PAGE

http://user42.tuxfamily.org/pod-minimumversion/index.html

=head1 COPYRIGHT

Copyright 2009, 2010, 2011 Kevin Ryde

Pod-MinimumVersion 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.

Pod-MinimumVersion 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
Pod-MinimumVersion.  If not, see <http://www.gnu.org/licenses/>.

=cut