SL/DB/Helper/TransNumberGenerator.pm

   1 package SL::DB::Helper::TransNumberGenerator;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6 our @EXPORT = qw(get_next_trans_number create_trans_number);
   7
   8 use Carp;
   9 use List::Util qw(max);
  10
  11 use SL::DB::Default;
  12
  13 my $oe_scoping = sub {
  14   SL::DB::Manager::Order->type_filter($_[0]);
  15 };
  16
  17 my $do_scoping = sub {
  18   SL::DB::Manager::DeliveryOrder->type_filter($_[0]);
  19 };
  20
  21 my %specs = ( ar                      => { number_column => 'invnumber',                                                             fill_holes_in_range => 1 },
  22               sales_quotation         => { number_column => 'quonumber', number_range_column => 'sqnumber',  scoping => $oe_scoping,                          },
  23               sales_order             => { number_column => 'ordnumber', number_range_column => 'sonumber',  scoping => $oe_scoping,                          },
  24               request_quotation       => { number_column => 'quonumber', number_range_column => 'rfqnumber', scoping => $oe_scoping,                          },
  25               purchase_order          => { number_column => 'ordnumber', number_range_column => 'ponumber',  scoping => $oe_scoping,                          },
  26               sales_delivery_order    => { number_column => 'donumber',  number_range_column => 'sdonumber', scoping => $do_scoping, fill_holes_in_range => 1 },
  27               purchase_delivery_order => { number_column => 'donumber',  number_range_column => 'pdonumber', scoping => $do_scoping, fill_holes_in_range => 1 },
  28             );
  29
  30 sub get_next_trans_number {
  31   my ($self, %params) = @_;
  32
  33   my $spec_type           = $specs{ $self->meta->table } ? $self->meta->table : $self->type;
  34   my $spec                = $specs{ $spec_type } || croak("Unsupported class " . ref($self));
  35
  36   my $number_column       = $spec->{number_column};
  37   my $number              = $self->$number_column;
  38   my $number_range_column = $spec->{number_range_column} || $number_column;
  39   my $scoping_conditions  = $spec->{scoping};
  40   my $fill_holes_in_range = $spec->{fill_holes_in_range};
  41
  42   return $number if $self->id && $number;
  43
  44   my $re              = '^(.*?)(\d+)$';
  45   my %conditions      = $scoping_conditions ? ( query => [ $scoping_conditions->($spec_type) ] ) : ();
  46   my @numbers         = map { $_->$number_column } @{ $self->_get_manager_class->get_all(%conditions) };
  47   my %numbers_in_use  = map { ( $_ => 1 )        } @numbers;
  48   @numbers            = grep { $_ } map { my @matches = m/$re/; @matches ? $matches[-1] * 1 : undef } @numbers;
  49
  50   my $defaults        = SL::DB::Default->get;
  51   my $number_range    = $defaults->$number_range_column;
  52   my @matches         = $number_range =~ m/$re/;
  53   my $prefix          = (2 != scalar(@matches)) ? ''  : $matches[ 0];
  54   my $ref_number      = !@matches               ? '1' : $matches[-1];
  55   my $min_places      = length($ref_number);
  56
  57   my $new_number      = $fill_holes_in_range ? $ref_number : max($ref_number, @numbers);
  58   my $new_number_full = undef;
  59
  60   while (1) {
  61     $new_number      =  $new_number + 1;
  62     my $new_number_s =  $new_number;
  63     $new_number_s    =~ s/\.\d+//g;
  64     $new_number_full =  $prefix . ('0' x max($min_places - length($new_number_s), 0)) . $new_number_s;
  65     last if !$numbers_in_use{$new_number_full};
  66   }
  67
  68   $defaults->update_attributes($number_range_column => $new_number_full) if $params{update_defaults};
  69   $self->$number_column($new_number_full)                                if $params{update_record};
  70
  71   return $new_number_full;
  72 }
  73
  74 sub create_trans_number {
  75   my ($self, %params) = @_;
  76
  77   return $self->get_next_trans_number(update_defaults => 1, update_record => 1, %params);
  78 }
  79
  80 1;
  81
  82 __END__
  83
  84 =pod
  85
  86 =encoding utf8
  87
  88 =head1 NAME
  89
  90 SL::DB::Helper::TransNumberGenerator - A mixin for creating unique record numbers
  91
  92 =head1 FUNCTIONS
  93
  94 =over 4
  95
  96 =item C<get_mext_trams_number %params>
  97
  98 Generates a new unique record number for the mixing class. Each record
  99 type (invoices, sales quotations, purchase orders etc) has its own
 100 number range. Within these ranges all numbers should be unique. The
 101 table C<defaults> contains the last record number assigned for all of
 102 the number ranges.
 103
 104 This function contains hard-coded knowledge about the modules it can
 105 be mixed into. This way the models themselves don't have to contain
 106 boilerplate code for the details like the the number range column's
 107 name in the C<defaults> table.
 108
 109 The process of creating a unique number involves the following steps:
 110
 111 At first all existing record numbers for the current type are
 112 retrieved from the database as well as the last number assigned from
 113 the table C<defaults>.
 114
 115 The next step is separating the number range from C<defaults> into two
 116 parts: an optional non-numeric prefix and its numeric suffix. The
 117 prefix, if present, will be kept intact.
 118
 119 Now the number itself is increased as often as neccessary to create a
 120 unique one by comparing the generated numbers with the existing ones
 121 retrieved in the first step. In this step gaps in the assigned numbers
 122 are filled for some tables (e.g. invoices) but not for others
 123 (e.g. sales orders).
 124
 125 After creating the unique record number this function can update
 126 C<$self> and the C<defaults> table if requested. This is controlled
 127 with the following parameters:
 128
 129 =over 2
 130
 131 =item * C<update_record>
 132
 133 Determines whether or not C<$self>'s record number field is set to the
 134 newly generated number. C<$self> will not be saved even if this
 135 parameter is trueish. Defaults to false.
 136
 137 =item * C<update_defaults>
 138
 139 Determines whether or not the number range value in the C<defaults>
 140 table should be updated. Unlike C<$self> the C<defaults> table will be
 141 saved. Defaults to false.
 142
 143 =back
 144
 145 Always returns the newly generated number. This function cannot fail
 146 and return a value. If it fails then it is due to exceptions.
 147
 148 =item C<create_trans_number %params>
 149
 150 Calls and returns L</get_next_trans_number> with the parameters
 151 C<update_defaults = 1> and C<update_record = 1>. C<%params> is passed
 152 to it as well.
 153
 154 =back
 155
 156 =head1 EXPORTS
 157
 158 This mixin exports all of its functions: L</get_next_trans_number> and
 159 L</create_trans_number>. There are no optional exports.
 160
 161 =head1 BUGS
 162
 163 Nothing here yet.
 164
 165 =head1 AUTHOR
 166
 167 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 168
 169 =cut