kivitendo/SL/PrefixedNumber.pm @ 68748667
| f50ddd66 | Moritz Bunkus | 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) = @_;
|
||||
| 7fde0dcd | Moritz Bunkus | return $self->set_to(max map { SL::PrefixedNumber->new(number => $_ // 0)->_state->{ref_number} } @numbers);
|
||
| f50ddd66 | Moritz Bunkus | }
|
||
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
|