package Data::ShortNameProvider::Style::Basic;
$Data::ShortNameProvider::Style::Basic::VERSION = '1.001';
use POSIX qw( strftime );
use Sub::Quote qw( quote_sub );
use Time::Local qw( timegm );

use Moo;
use namespace::clean;

with 'Data::ShortNameProvider::Role::Style';

has version => (
    is      => 'ro',
    default => '1',
    isa     => quote_sub( << 'ISA' ),
    my ($v) = @_;
    die "'$v' is not a integer" if $v !~ /^(?:0|[1-9][0-9]*)$/;
ISA
);

has prefix => (
    is      => 'ro',
    default => 'dsnp',
);

# derived attributes

has timestamp => (
    is       => 'lazy',
    init_arg => undef,
    builder  => sub { strftime '%y%m%d', gmtime shift->timestamp_epoch; },
);

has parsing_regexp => (
    is       => 'lazy',
    init_arg => undef,
    builder  => sub {
        my ($self) = @_;
        my $re = quotemeta( $self->prefix )    # prefix
          . '(0|[1-9][0-9]*)_'                                       # version
          . '([0-9][0-9])(0[1-9]|1[012])(0[1-9]|[12][0-9]|3[01])__'  # timestamp
          . '(.*)';                                                  # name
          return qr/^$re$/;
    },
);

sub generate_name {
    my ( $self, $name ) = @_;
    return
        $self->prefix
      . $self->version . '_'
      . $self->timestamp . '__'
      . $name;
}

sub parse_generated_name {
    my ( $self, $short_name ) = @_;
    return undef if $short_name !~ $self->parsing_regexp;
    return {
        prefix          => $self->prefix,
        version         => $1,
        timestamp       => "$2$3$4",
        timestamp_epoch => timegm( 0, 0, 0, $4, $3 - 1, $2 ),
        name            => $5,
    };
}

sub is_generated_name {
    my ( $self, $short_name ) = @_;
    return scalar $short_name =~ $self->parsing_regexp;
}

1;

__END__

=head1 NAME

Data::ShortNameProvider::Style::Basic - Basic style for Data::ShortNameProvider

=head1 SYNOPSIS

Via L<Data::ShortNameProvider>:

    my $np = Data::ShortNameProvider->new(
        style           => 'Basic',       # default
        timestamp_epoch => 1400023019,    # defaults to time()
        max_name_length => 32,            # croak if a longer name is generated

        # style-specific arguments
        prefix  => 'dbit',
        version => 1,
    );

Directly:

    my $np = Data::ShortNameProvider::Style::Basic->new(
        timestamp_epoch => 1400023019,    # defaults to time()
        prefix          => 'dbit',
        version         => 1,
    );

Generate a shortname:

    $short_name = $np->generate_name('foo');   # returns "dbit1_140513__foo"

=head1 DESCRIPTION

Short names generated with this style will look like the following:

    <prefix><version>_<YYMMDD>__<name>

=head1 ATTRIBUTES

=head2 prefix

A string prefix for the short name.

=head2 version

The application can use C<version> to indicate some change in semantics.
I.e., the application could use the version string to give itself some
hints about what the short name really means.

One could argue that version could be handled by the application by having
it add a digit to the prefix but it seems better to keep them separate.

Default: C<1>.

=head2 timestamp_epoch

This is a timestamp in Unix epoch, that may be used by the style to
produce short names.

Provided by L<Data::ShortNameProvider::Role::Style>.

=head2 timestamp

The actual timestamp string used in the generated short name, as produced
from L</timestamp_epoch>.

=head2 parsing_regexp

The regular expression used to parse a generated name back into its
components.

=head1 METHODS

=head2 generate_name

    my $short_name = $provider->parse_generated_name( $name );

Generate a "short name" for the C<$name> parameter.

=head2 parse_generated_name

    my $hash = $provider->parse_generated_name( $short_name );

Return the components of the name as a hash.

=head2 is_generated_name

    if( $provider->is_generated_name( $name ) ) { ... }

Return a boolean indicating if the C<$name> string could have been
generated by this provider.

Provided by L<Data::ShortNameProvider::Role::Style>.

=head1 AUTHOR

Philippe Bruhat (BooK), <book@cpan.org>.

=head1 COPYRIGHT

Copyright 2014-2015 Philippe Bruhat (BooK), all rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
