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