File Coverage

blib/lib/App/FileSummoner/Register.pm

Criterion	Covered	Total	%
statement	13	32	40.6
branch	0	10	0.0
condition			n/a
subroutine	5	10	50.0
pod	4	5	80.0
total	22	57	38.6

package App::FileSummoner::Register;
BEGIN {
  $App::FileSummoner::Register::VERSION = '0.005';
}

use 5.006;
use strict;
use warnings;

=head1 NAME

App::FileSummoner::Register - Skeletons register

=cut

my ( @rules, %skeleton );

=head1 SYNOPSIS

    registerSkeleton(qr/\.pm$/, 'perl/skeleton.pm');

    my $skeleton = chooseSkeleton('some/path/Module.pm');

=head1 EXPORT

=over 2

=item registerSkeleton

=item chooseSkeleton

=back

=cut

use Exporter 'import';
our @EXPORT_OK = qw(registerSkeleton chooseSkeleton);

=head1 SUBROUTINES

=head2 registerSkeleton

Register new skeleton for a given rule. Use in I<rules.pl> file.

=cut

sub registerSkeleton {
    my ( $rule, $skeleton ) = @_;

    return if defined $skeleton{$rule};
    push @rules, $rule;
    $skeleton{$rule} = $skeleton;
}

=head2 chooseSkeleton

Choose the best skeleton for a given file.

=cut

sub chooseSkeleton {
    my ($fileName) = @_;

    foreach my $rule (@rules) {
        return $skeleton{$rule} if ruleMatches( $rule, $fileName );
    }

    return undef;
}

=head2 unregisterAll

=cut

sub unregisterAll {
    @rules = ();
    %skeleton = ();
}

=head2 ruleMatches

Check if a filename matches a given rule.

=cut

sub ruleMatches {
    my ( $rule, $fileName ) = @_;

    return rulesMatches( $rule, $fileName ) if ref $rule eq 'ARRAY';
    return &$rule($fileName) if ref $rule eq 'CODE';
    return $fileName =~ $rule;
}

sub rulesMatches {
    my ( $rulesRef, $fileName ) = @_;

    foreach my $rule (@{ $rulesRef }) {
        ruleMatches($rule, $fileName) || return 0;
    }
    return 1;
}

1;