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