File Coverage

lib/Badger/Data/Facets.pm
Criterion Covered Total %
statement 15 16 93.7
branch 7 8 87.5
condition 2 3 66.6
subroutine 2 2 100.0
pod 1 1 100.0
total 27 30 90.0


line stmt bran cond sub pod time code
1             #========================================================================
2             #
3             # Badger::Data::Facets
4             #
5             # DESCRIPTION
6             # Factory for Badger::Data::Facets validation objects.
7             #
8             # AUTHOR
9             # Andy Wardley
10             #
11             #========================================================================
12              
13             package Badger::Data::Facets;
14              
15             use Badger::Factory::Class
16 7         29 version => 0.01,
17             debug => 0,
18             item => 'facet',
19             path => 'Badger::Data::Facet BadgerX::Data::Facet',
20 7     7   3865 constants => 'HASH DOT';
  7         17  
21              
22              
23             our $PREFIXES = {
24             text => 'text',
25             number => 'number',
26             list => 'list',
27             };
28              
29              
30             sub type_args {
31 20     20 1 37 my $self = shift;
32 20         30 my $type = shift; # my $save = $type; # tmp debug
33 20         29 my $name = $type;
34 20         33 my $base;
35              
36             # See if we recognise the initial XXX_ prefix as a short-cut.
37             # If so then the part afterwords is the name we're interested in,
38             # e.g. text_max_length becomes 'text.max_length' which the factory
39             # module will map to '::Text::MaxLength' for loading, while
40             # 'max_length' is the name that we'll use as a default argument name.
41            
42 20 100       159 if ($type =~ s/^([^\W_]+)(\.|_)(.*)/$3/) {
43 17 100       63 if ($2 eq DOT) {
    50          
44 12         31 $type = $1.DOT.$type;
45 12         20 $name = $3;
46             }
47             elsif ($base = $PREFIXES->{ $1 }) {
48 5         14 $type = $base.DOT.$type;
49 5         12 $name = $3;
50             }
51             else {
52 0         0 $type = $1.$2.$type;
53             }
54             }
55              
56 20 100 66     107 my $args = @_ && ref $_[0] eq HASH ? shift : { $name => shift };
57              
58             # $self->debug("save:$save / type:$type / base:$base / name:$name");
59              
60 20         86 return ($type, $args);
61             }
62              
63              
64             1;
65              
66             __END__