File Coverage

blib/lib/ctflags/check.pm

Criterion	Covered	Total	%
statement	13	23	56.5
branch	4	26	15.3
condition	5	33	15.1
subroutine	7	16	43.7
pod	0	13	0.0
total	29	111	26.1

package ctflags::check;

our $VERSION = '0.02';

use 5.006;
use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);

# this package is supposed to be private to ctflags and companion
# packages, not used from any other module so it uses directly
# @EXPORT.
our @EXPORT = qw( chack_identifier
		  check_ns
		  check_flag
		  check_value
		  check_flagset
		  check_flagsetext
		  check_alias
		  check_defopt
		  check_envname
		  check_cntprefix
		  check_package
		  check_sub
		  $identifier_re
		  $ns_re
		  $flag_re
		  $value_re
		  $flagset_re
		  $flagsetext_re
		  $alias_re
		  $envname_re
		  $cntprefix_re
		  $package_re
		);


sub myquote ($ ) {
  my $v=shift;
  defined $v ? "'$v'" : "'undef'";
}


our $identifier_re = qr|[a-zA-Z_]\w*|;
sub check_identifier ($ ) {
  (defined $_[0] and $_[0]=~/^$identifier_re$/o)
    or die "invalid perl identifier ".myquote($_[0])."\n";
}

our $ns_re=qr|$identifier_re(?::$identifier_re)*|;
sub check_ns ($ ) {
  (defined $_[0] and $_[0]=~/^$ns_re$/o)
    or die "invalid namespace specification ".myquote($_[0])."\n";
}

our $flag_re=qr|[a-zA-Z]|;
sub check_flag ($ ) {
  (defined $_[0] and $_[0]=~/^$flag_re$/o)
    or die "invalid ctflag specification ".myquote($_[0])."\n";
}

our $value_re=qr|\d+|;
sub check_value ($ ) {
  (!defined $_[0] or $_[0]=~/^$value_re$/o)
    or die "invalid ctflag value ".myquote($_[0])."\n";
}

our $flagset_re=qr|(?:$flag_re)*|;
sub check_flagset ($ ) {
  (defined $_[0] and $_[0]=~/^$flagset_re$/o)
    or die "invalid ctflags set ".myquote($_[0])."\n";
}

our $flagsetext_re=qr{\*|!?$flagset_re};
sub check_flagsetext ($) {
  (defined $_[0] and $_[0]=~/^$flagsetext_re$/o)
    or die "invalid ctflags set ".myquote($_[0])."\n";
}

our $alias_re=$identifier_re;
sub check_alias($ ) {
  (defined $_[0] and $_[0]=~/^$identifier_re$/o)
    or die "invalid alias specification ".myquote($_[0])."\n";
}

sub check_defopt($$) {
  defined $_[0]
    or die "'undef' is not a valid value for option '$_[1]'\n";
}

our $envname_re=$identifier_re;
sub check_envname($ ) {
  (defined $_[0] and $_[0]=~/^$envname_re$/o)
    or die "invalid environment variable name ".myquote($_[0])."\n";
}

our $cntprefix_re=qr/(?:$identifier_re)?/;
sub check_cntprefix ($ ) {
  (defined $_[0] and $_[0]=~/^$cntprefix_re$/o)
    or die "invalid constant prefix ".myquote($_[0])."\n";
}

our $package_re=qr|$identifier_re(?:::$identifier_re)*|;
sub check_package ($ ) {
  (defined $_[0] and $_[0]=~/^$package_re$/o)
    or die "invalid package name ".myquote($_[0])."\n";
}

sub check_sub ($) {
  (defined $_[0] and UNIVERSAL::isa($_[0], 'CODE'))
    or die "invalid sub ".myquote($_[0])."\n";
}

1;
__END__