|
1 |
package SL::DB::Helper::TransNumberGenerator;
|
|
2 |
|
|
3 |
use strict;
|
|
4 |
|
|
5 |
use parent qw(Exporter);
|
|
6 |
our @EXPORT = qw(get_next_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;
|
Helfer-Modul zum Erzeugen von eindeutigen Belegnummern
Conflicts: