projekt kivitendo

use SL::PrefixedNumber;

  my %conditions     = $scoping_conditions ? ( query => [ $scoping_conditions->($spec_type) ] ) : ();

  my @numbers        = map { $_->$number_column } @{ $self->_get_manager_class->get_all(%conditions) };

  my %numbers_in_use = map { ( $_ => 1 )        } @numbers;

  my $defaults       = SL::DB::Default->get;

  my $sequence       = SL::PrefixedNumber->new(number => $defaults->$number_range_column);

  $sequence->set_to_max(@numbers) if !$fill_holes_in_range;

  my $new_number = $sequence->get_next;

  $new_number    = $sequence->get_next while $numbers_in_use{$new_number};

  $defaults->update_attributes($number_range_column => $new_number) if $params{update_defaults};

  $self->$number_column($new_number)                                if $params{update_record};

  return $new_number;

use SL::PrefixedNumber;

  $var   = SL::PrefixedNumber->new(number => $var)->get_next;

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 => $_)->_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

use SL::PrefixedNumber;

  my $sequence       = SL::PrefixedNumber->new(number => $number);

    $number = $sequence->get_next;

use Test::More tests => 14;

use Test::Exception;

use strict;

use lib 't';

use utf8;

use Data::Dumper;

use Support::TestSetup;

use_ok 'SL::PrefixedNumber';

sub n {

  return SL::PrefixedNumber->new(number => $_[0]);

}

is(n('FB4711'     )->get_next, 'FB4712',      'increment FB4711');

is(n('4711'       )->get_next, '4712',        'increment 4711');

is(n('FB54UFB4711')->get_next, 'FB54UFB4712', 'increment FB54UFB4711');

is(n('FB'         )->get_next, 'FB1',         'increment FB');

is(n(''           )->get_next, '1',           'increment ""');

is(n('0042-FB'    )->get_next, '0042-FB1',    'increment 0042-FB');

my $o = n('0042-FB');

$o->get_next;

is($o->get_next,               '0042-FB2',    'increment 0042-FB twice');

is(n('FB4711')->set_to(54), 'FB0054', 'set FB4711 to 54');

$o = n('FB4711');

$o->set_to(54);

is($o->get_next,            'FB0055', 'set FB4711 to 54 then increment');

is(n('FB121231')->get_current,                          'FB121231', 'set FB121231 get current');

is(n('FB121231')->format(42),                           'FB000042', 'set FB121231 format 42');

is(n('FB123123')->set_to_max('FB0711', 'FB911', 'FB8'), 'FB000911', 'set FB123123 max FB000911');

throws_ok { n()->get_next } qr/no.*number/i, 'get_next without number set';