From f50ddd66b0b90f206c762c95770da530cb0b7d69 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Tue, 12 Mar 2013 11:48:37 +0100 Subject: [PATCH] =?utf8?q?SL::PrefixedNumber=20--=20Nummernkreisartige=20N?= =?utf8?q?ummer=20erh=C3=B6hen=20ohne=20Datenbank?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- SL/DB/Helper/TransNumberGenerator.pm | 45 ++++----- SL/Form.pm | 11 +-- SL/PrefixedNumber.pm | 139 +++++++++++++++++++++++++++ SL/TransNumber.pm | 11 +-- t/prefixed_number.t | 37 +++++++ 5 files changed, 198 insertions(+), 45 deletions(-) create mode 100644 SL/PrefixedNumber.pm create mode 100644 t/prefixed_number.t diff --git a/SL/DB/Helper/TransNumberGenerator.pm b/SL/DB/Helper/TransNumberGenerator.pm index 4b4fe126d..41dba2cd7 100644 --- a/SL/DB/Helper/TransNumberGenerator.pm +++ b/SL/DB/Helper/TransNumberGenerator.pm @@ -9,6 +9,7 @@ use Carp; use List::Util qw(max); use SL::DB::Default; +use SL::PrefixedNumber; sub oe_scoping { SL::DB::Manager::Order->type_filter($_[0]); @@ -50,34 +51,22 @@ sub get_next_trans_number { 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 { diff --git a/SL/Form.pm b/SL/Form.pm index 141233d94..044d45f53 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -62,6 +62,7 @@ use SL::Mailer; 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; @@ -3189,15 +3190,7 @@ sub update_defaults { 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); diff --git a/SL/PrefixedNumber.pm b/SL/PrefixedNumber.pm new file mode 100644 index 000000000..849421f97 --- /dev/null +++ b/SL/PrefixedNumber.pm @@ -0,0 +1,139 @@ +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 + +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 + +Returns the current number in the sequence (formatted). Does not +modify C<$self>. + +=item C + +Returns the next number in the sequence (formatted). Modifies C<$self> +accordingly so that calling C multiple times will actually +iterate over the sequence. + +=item C + +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 + +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 Em.bunkus@linet-services.deE + +=cut diff --git a/SL/TransNumber.pm b/SL/TransNumber.pm index 4f8cb4345..210abc091 100644 --- a/SL/TransNumber.pm +++ b/SL/TransNumber.pm @@ -7,6 +7,7 @@ use parent qw(Rose::Object); use Carp; use List::MoreUtils qw(any none); use SL::DBUtils; +use SL::PrefixedNumber; use Rose::Object::MakeMethods::Generic ( @@ -129,16 +130,10 @@ SQL 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) { diff --git a/t/prefixed_number.t b/t/prefixed_number.t new file mode 100644 index 000000000..1fc762f74 --- /dev/null +++ b/t/prefixed_number.t @@ -0,0 +1,37 @@ +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'; -- 2.20.1