File Coverage

blib/lib/Data/ShortNameProvider.pm
Criterion Covered Total %
statement 34 34 100.0
branch 8 8 100.0
condition 6 6 100.0
subroutine 9 9 100.0
pod 2 4 50.0
total 59 61 96.7


line stmt bran cond sub pod time code
1             package Data::ShortNameProvider;
2             $Data::ShortNameProvider::VERSION = '1.001';
3 1     1   27924 use Carp;
  1         2  
  1         70  
4 1     1   593 use Module::Runtime qw( require_module );
  1         1648  
  1         7  
5              
6 1     1   733 use Moo;
  1         13250  
  1         7  
7 1     1   1994 use namespace::clean;
  1         11500  
  1         5  
8              
9             # attributes
10             my @attributes = qw( style max_name_length );
11              
12             has style => (
13             is => 'ro',
14             default => 'Basic',
15             );
16              
17             has max_name_length => (
18             is => 'ro',
19             required => 1,
20             );
21              
22             has provider => (
23             is => 'lazy',
24             init_arg => undef,
25             handles => [ 'is_generated_name', 'timestamp_epoch' ],
26             );
27              
28             sub _build_provider {
29 14     14   413 my ($self) = shift;
30 14         24 my $class = $self->style;
31              
32 14         35 require_module($class);
33              
34             croak "$class does not implement the Data::ShortNameProvider::Role::Style role"
35 13 100       187 if !eval { $class->does('Data::ShortNameProvider::Role::Style') };
  13         204  
36              
37 12         287 return $class->new( $self->extra );
38             }
39              
40             # extra attributes passed to instantiate the delegate
41             # any value passed to the constructor will be ignored
42             # as it is populated by BUILDARGS from leftover arguments
43             has extra => ( is => 'ro' );
44              
45             sub BUILDARGS {
46 15     15 0 9165 my $args = Moo::Object::BUILDARGS(@_);
47              
48             # copy all arguments but the Data::ShortName::Provider ones in 'extra'
49 15         143 $args->{extra} = { %$args };
50 15         56 delete $args->{extra}{$_} for @attributes;
51              
52             # allow short style names
53 15 100 100     82 $args->{style} = "Data::ShortNameProvider::Style::$args->{style}"
54             if exists $args->{style} && $args->{style} !~ /::/;
55              
56 15         193 return $args;
57             }
58              
59             # ensure the provider is built during construction
60 14     14 0 312 sub BUILD { shift->provider }
61              
62             #
63             # methods
64             #
65              
66             #
67             # most stuff is delegated to the provider
68             #
69              
70             sub generate_name {
71 12     12 1 5192 my ( $self, $name ) = @_;
72 12         190 my $short_name = $self->provider->generate_name($name);
73              
74             # enforce length restrictions
75 12 100 100     75 if ( $self->max_name_length
76             && length($short_name) > $self->max_name_length )
77             {
78 2         296 croak sprintf
79             "%s (provided by %s) is longer than the %d characters limit",
80             $short_name, $self->style, $self->max_name_length;
81             }
82              
83 10         35 return $short_name;
84             }
85              
86             sub parse_generated_name {
87 8     8 1 13 my ( $self, $name ) = @_;
88 8         137 my $hash = $self->provider->parse_generated_name($name);
89 8 100       114 return $hash if !$hash;
90 4         26 $hash->{$_} = $self->$_ for @attributes;
91 4         9 return $hash;
92             }
93              
94             1;
95              
96             __END__