use List::Util qw(max);
use SL::DB::Default;
+use SL::PrefixedNumber;
sub oe_scoping {
SL::DB::Manager::Order->type_filter($_[0]);
return $number if $self->id && $number;
- my $re = '^(.*?)(\d+)$';
- 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;
- @numbers = grep { $_ } map { my @matches = m/$re/; @matches ? $matches[-1] * 1 : undef } @numbers;
-
- my $defaults = SL::DB::Default->get;
- my $number_range = $defaults->$number_range_column;
- my @matches = $number_range =~ m/$re/;
- my $prefix = (2 != scalar(@matches)) ? '' : $matches[ 0];
- my $ref_number = !@matches ? '1' : $matches[-1];
- my $min_places = length($ref_number);
-
- my $new_number = $fill_holes_in_range ? $ref_number : max($ref_number, @numbers);
- my $new_number_full = undef;
-
- while (1) {
- $new_number = $new_number + 1;
- my $new_number_s = $new_number;
- $new_number_s =~ s/\.\d+//g;
- $new_number_full = $prefix . ('0' x max($min_places - length($new_number_s), 0)) . $new_number_s;
- last if !$numbers_in_use{$new_number_full};
- }
-
- $defaults->update_attributes($number_range_column => $new_number_full) if $params{update_defaults};
- $self->$number_column($new_number_full) if $params{update_record};
-
- return $new_number_full;
+ 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;
}
sub create_trans_number {
use SL::Menu;
use SL::MoreCommon qw(uri_encode uri_decode);
use SL::OE;
+use SL::PrefixedNumber;
use SL::Request;
use SL::Template;
use SL::User;
my ($var) = $sth->fetchrow_array;
$sth->finish;
- if ($var =~ m/\d+$/) {
- my $new_var = (substr $var, $-[0]) * 1 + 1;
- my $len_diff = length($var) - $-[0] - length($new_var);
- $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
-
- } else {
- $var = $var . '1';
- }
-
+ $var = SL::PrefixedNumber->new(number => $var)->get_next;
$query = qq|UPDATE defaults SET $fld = ?|;
do_query($self, $dbh, $query, $var);
--- /dev/null
+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 Carp;
use List::MoreUtils qw(any none);
use SL::DBUtils;
+use SL::PrefixedNumber;
use Rose::Object::MakeMethods::Generic
(
my $number = $business_number;
($number) = selectfirst_array_query($form, $self->dbh, qq|SELECT $filters{numberfield} FROM defaults|) if !$number;
$number ||= '';
+ my $sequence = SL::PrefixedNumber->new(number => $number);
do {
- if ($number =~ m/\d+$/) {
- my $new_number = substr($number, $-[0]) * 1 + 1;
- my $len_diff = length($number) - $-[0] - length($new_number);
- $number = substr($number, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_number;
-
- } else {
- $number = $number . '1';
- }
+ $number = $sequence->get_next;
} while ($numbers_in_use{$number});
if ($self->save) {
--- /dev/null
+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';
projects / kivitendo-erp.git / commitdiff