|
package SL::PrefixedNumber;
|
|
|
|
use strict;
|
|
|
|
use parent qw(Rose::Object);
|
|
|
|
use Carp;
|
|
use List::Util qw(max);
|
|
|
|
use Rose::Object::MakeMethods::Generic
|
|
(
|
|
scalar => [ qw(number) ],
|
|
'scalar --get_set_init' => [ qw(_state) ],
|
|
);
|
|
|
|
sub init__state {
|
|
my ($self) = @_;
|
|
|
|
croak "No 'number' set" if !defined($self->number);
|
|
|
|
my @matches = $self->number =~ m/^(.*?)(\d+)$/;
|
|
my @matches2 = $self->number =~ m/^(.*[^\d])$/;
|
|
my $prefix = @matches2 ? $matches2[0] : (2 != scalar(@matches)) ? '' : $matches[ 0],;
|
|
my $ref_number = !@matches ? '0' : $matches[-1];
|
|
my $min_places = length $ref_number;
|
|
|
|
return {
|
|
prefix => $prefix,
|
|
ref_number => $ref_number,
|
|
min_places => $min_places,
|
|
};
|
|
}
|
|
|
|
sub get_current {
|
|
my ($self) = @_;
|
|
|
|
return $self->format($self->_state->{ref_number});
|
|
}
|
|
|
|
sub get_next {
|
|
my ($self) = @_;
|
|
|
|
return $self->set_to($self->_state->{ref_number} + 1);
|
|
}
|
|
|
|
sub format {
|
|
my ($self, $number) = @_;
|
|
|
|
my $state = $self->_state;
|
|
$number =~ s/\.\d+//g;
|
|
|
|
return $state->{prefix} . ('0' x max($state->{min_places} - length($number), 0)) . $number;
|
|
}
|
|
|
|
sub set_to {
|
|
my ($self, $new_number) = @_;
|
|
|
|
my $state = $self->_state;
|
|
$state->{ref_number} = $new_number;
|
|
|
|
return $self->number($self->format($new_number));
|
|
}
|
|
|
|
sub set_to_max {
|
|
my ($self, @numbers) = @_;
|
|
|
|
return $self->set_to(max map { SL::PrefixedNumber->new(number => $_ // 0)->_state->{ref_number} } @numbers);
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=encoding utf8
|
|
|
|
=head1 NAME
|
|
|
|
SL::PrefixedNumber - Increment a number prefixed with some text
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
my $number = SL::PrefixedNumber->new(number => 'FB000042')->get_next;
|
|
print $number; # FB000043
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=over 4
|
|
|
|
=item C<format $number>
|
|
|
|
Returns C<$number> formatted according to the rules in C<$self>. Does
|
|
not modify C<$self>. E.g.
|
|
|
|
my $sequence = SL::PrefixedNumber->new('FB12345');
|
|
print $sequence->format(42); # FB00042
|
|
print $sequence->get_next; # FB12346
|
|
|
|
=item C<get_current>
|
|
|
|
Returns the current number in the sequence (formatted). Does not
|
|
modify C<$self>.
|
|
|
|
=item C<get_next>
|
|
|
|
Returns the next number in the sequence (formatted). Modifies C<$self>
|
|
accordingly so that calling C<get_next> multiple times will actually
|
|
iterate over the sequence.
|
|
|
|
=item C<set_to $number>
|
|
|
|
Sets the current postfix to C<$number> but does not change the
|
|
prefix. Returns the formatted new number. E.g.:
|
|
|
|
my $sequence = SL::PrefixedNumber->new(number => 'FB000042');
|
|
print $sequence->set_to(123); # FB000123
|
|
print $sequence->get_next; # FB000124
|
|
|
|
=item C<set_to_max @numbers>
|
|
|
|
Sets the current postfix to the maximum of all the numbers listed in
|
|
C<@numbers>. All those numbers can be prefixed numbers. Returns the
|
|
formatted maximum number. E.g.
|
|
|
|
my $sequence = SL::PrefixedNumber->new(number => 'FB000042');
|
|
print $sequence->set_to_max('FB000123', 'FB999', 'FB00001'); # FB000999
|
|
print $sequence->get_next; # FB001000
|
|
|
|
=back
|
|
|
|
=head1 BUGS
|
|
|
|
Nothing here yet.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
|
|
|
=cut
|