SL::PrefixedNumber -- Nummernkreisartige Nummer erhöhen ohne Datenbank

diff --git a/SL/DB/Helper/TransNumberGenerator.pm b/SL/DB/Helper/TransNumberGenerator.pm
index 4b4fe126d50ad3547b75135af5d630ee2532edc9..41dba2cd7e012915c89f71b0b6a2d25d0ae68410 100644 (file)
--- 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 List::Util qw(max);
 
 use SL::DB::Default;

+use SL::PrefixedNumber;

 
 sub oe_scoping {
   SL::DB::Manager::Order->type_filter($_[0]);
 
 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;
 
 
   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 {
 }
 
 sub create_trans_number {

diff --git a/SL/Form.pm b/SL/Form.pm
index 141233d94c94735f3f1efbec418441508cfc4bcc..044d45f53837709508e04b4769207ff9ae99ca0a 100644 (file)
--- 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::Menu;
 use SL::MoreCommon qw(uri_encode uri_decode);
 use SL::OE;

+use SL::PrefixedNumber;

 use SL::Request;
 use SL::Template;
 use SL::User;
 use SL::Request;
 use SL::Template;
 use SL::User;


@@ -3189,15 +3190,7 @@ sub update_defaults {
   my ($var) = $sth->fetchrow_array;
   $sth->finish;
 
   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);
 
   $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 (file)
index 0000000..849421f
--- /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<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

diff --git a/SL/TransNumber.pm b/SL/TransNumber.pm
index 4f8cb43451ee98ce431c6e4d63a8046d6e1f9661..210abc091fa253e2c16f348f6f74e2db18f65a91 100644 (file)
--- 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 Carp;
 use List::MoreUtils qw(any none);
 use SL::DBUtils;

+use SL::PrefixedNumber;

 
 use Rose::Object::MakeMethods::Generic
 (
 
 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 $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 {
 
   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) {
   } while ($numbers_in_use{$number});
 
   if ($self->save) {

diff --git a/t/prefixed_number.t b/t/prefixed_number.t
new file mode 100644 (file)
index 0000000..1fc762f
--- /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';