File Coverage

blib/lib/Module/Checkstyle/Util.pm

Criterion	Covered	Total	%
statement	48	50	96.0
branch	26	30	86.6
condition	11	16	68.7
subroutine	11	11	100.0
pod	7	7	100.0
total	103	114	90.3

package Module::Checkstyle::Util;

use strict;
use warnings;

use Carp qw(croak);

use Module::Checkstyle::Problem;

require Exporter;

our @ISA         = qw(Exporter);

our @EXPORT      = qw();
our @EXPORT_OK   = qw(format_expected_err new_problem as_true as_numeric as_regexp is_valid_position is_valid_align);
our %EXPORT_TAGS = ( all     => [@EXPORT_OK],
                     problem => [qw(format_expected_err new_problem)],
                     args    => [qw(as_true as_numeric as_regexp is_valid_position is_valid_align)],
                );

sub format_expected_err {
    my ($expected, $got) = @_;

    $expected = ref $expected || $expected;
    $got      = ref $got      || $got;

    $expected = q{} if !defined $expected;
    $got      = q{} if !defined $got;

    return qq(Expected '$expected' but got '$got');
}

sub new_problem {
    my $problem;

    if (@_ == 4) {
        $problem = Module::Checkstyle::Problem->new(@_);
    }
    elsif (@_ == 5) {
        my ($config, $directive, $message, $line, $file) = @_;
        my $severity;

        my ($caller) = caller =~ /^Module::Checkstyle::Check::(.*)$/;
        if ($caller) {
            $severity = $config->get_severity($caller, $directive);
        }
        else {
            $severity = $config->get_severity('_', 'global-error-level');
        }

        $problem = Module::Checkstyle::Problem->new($severity, $message, $line, $file);
    }
    else {
        croak "Module::Checkstyle::Util::new_problem() called with wrong number of arguments";
    }

    return $problem;
}

sub as_true {
    my $value = shift;
    return 0 if !defined $value || !$value;
    return 1 if $value =~ m/^ y | yes | true | 1 $/xi;
    return 0;
}

sub as_numeric {
    my $value = shift;

    return 0       if !defined $value || !$value;
    return $value  if $value =~ /^\-?\d+$/;
    return 0;
}

sub as_regexp {
    my $value = shift;
    return undef if !defined $value;
    return undef if $value =~ /^\s*$/;

    if ($value !~ /^qr/) {
        $value = 'qr' . $value;
    }

    my $re = eval $value;
    return undef if $@;
    return $re;
}

sub is_valid_position {
    my $value = shift || "";
    return $value =~ /^same|alone$/i ? 1 : 0;
}


sub is_valid_align {
    my $value = shift || "";
    return $value =~ /^left|middle|right$/i ? 1 : 0
}

1;
__END__