File Coverage

blib/lib/Acme/No.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	17	18	94.4
condition	9	11	81.8
subroutine	7	7	100.0
pod			n/a
total	70	73	95.8

package Acme::No;

use 5.00503;

use Carp qw(croak);
use UNIVERSAL ();

use strict;

use Filter::Util::Call;

$Acme::No::VERSION = '0.03';

sub import {

  filter_add(sub {

    my $status = 0;

    if (($status = filter_read) > 0) {

      my (undef, $no, $module, $version) = m/(^|;)\s*(no)\s+([\w\-:]*)\s*(\d+[.]?(\d+[._]?)*)/;

      if ($no && $module && $version) {
        # no mod_perl 2.0;

        if ($module eq 'v') {
          # fall through to Perl part if we caught 'no v5.6.0'
        }
        else {

          eval "require $module" or die $@;

          my $modversion = UNIVERSAL::VERSION($module);

          croak "$module version $modversion too high--version less than $version required"
            unless $modversion < $version;

          undef $no;  # we're done
        }
      }

      if ($no && $version) {
        # no 6.0;

        # perl version foo (ugh)
        my ($rev, $ver, $subver) = split '[._]', $version;

        if ($ver > 1000) {              # 5.006001
          $subver = ($ver % 1000);
          $ver = int($ver / 1000);
        }
        elsif ($ver > 100) {            # 5.00503
          $subver = ($ver % 100) * 10;
          $ver = int($ver / 100);
        }
        else {                          # silence undef warnings
          $subver ||= 0;
        }

        $version = $rev + ($ver/1000) + ($subver/1000000);

        croak "Perl v$] too high--version less than v$version required"
          unless $] < $version;
      }

      # wipe away user code so the real perl doesn't
      # barf on our implementation
      s/(no)\s+([\w\-:]*)\s*(\d+[.]?(\d+[._]?)*)//;
    }

    return $status;
  });
}

1;

__END__