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

package Data::ShortNameProvider;
$Data::ShortNameProvider::VERSION = '1.001';
use Carp;
use Module::Runtime qw( require_module );

use Moo;
use namespace::clean;

# attributes
my @attributes = qw( style max_name_length );

has style => (
    is      => 'ro',
    default => 'Basic',
);

has max_name_length => (
    is       => 'ro',
    required => 1,
);

has provider => (
    is       => 'lazy',
    init_arg => undef,
    handles  => [ 'is_generated_name', 'timestamp_epoch' ],
);

sub _build_provider {
    my ($self) = shift;
    my $class = $self->style;

    require_module($class);

    croak "$class does not implement the Data::ShortNameProvider::Role::Style role"
      if !eval { $class->does('Data::ShortNameProvider::Role::Style') };

    return $class->new( $self->extra );
}

# extra attributes passed to instantiate the delegate
# any value passed to the constructor will be ignored
# as it is populated by BUILDARGS from leftover arguments
has extra => ( is => 'ro' );

sub BUILDARGS {
    my $args = Moo::Object::BUILDARGS(@_);

    # copy all arguments but the Data::ShortName::Provider ones in 'extra'
    $args->{extra} = { %$args };
    delete $args->{extra}{$_} for @attributes;

    # allow short style names
    $args->{style} = "Data::ShortNameProvider::Style::$args->{style}"
      if exists $args->{style} && $args->{style} !~ /::/;

    return $args;
}

# ensure the provider is built during construction
sub BUILD { shift->provider }

#
# methods
#

#
# most stuff is delegated to the provider
#

sub generate_name {
    my ( $self, $name ) = @_;
    my $short_name = $self->provider->generate_name($name);

    # enforce length restrictions
    if ( $self->max_name_length
        && length($short_name) > $self->max_name_length )
    {
        croak sprintf
          "%s (provided by %s) is longer than the %d characters limit",
          $short_name, $self->style, $self->max_name_length;
    }

    return $short_name;
}

sub parse_generated_name {
    my ( $self, $name ) = @_;
    my $hash = $self->provider->parse_generated_name($name);
    return $hash if !$hash;
    $hash->{$_} = $self->$_ for @attributes;
    return $hash;
}

1;

__END__