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