use SL::MoreCommon;
use SL::IC;
use SL::IO;
+use SL::TransNumber;
use Data::Dumper;
use strict;
my ($self, $myconfig, $form, $provided_dbh, $payments_only) = @_;
# connect to database, turn off autocommit
- my $dbh = $provided_dbh ? $provided_dbh : $form->dbconnect_noauto($myconfig);
+ my $dbh = $provided_dbh ? $provided_dbh : $form->get_standard_dbh;
my ($query, $sth, $null, $project_id, @values);
my $exchangerate = 0;
&reverse_invoice($dbh, $form);
} else {
+ my $trans_number = SL::TransNumber->new(type => $form->{type}, dbh => $dbh, number => $form->{invnumber}, save => 1);
+ $form->{invnumber} = $trans_number->create_unique unless $trans_number->is_unique;
+
$query = qq|SELECT nextval('glid')|;
($form->{"id"}) = selectrow_query($form, $dbh, $query);
{ name => "FCGI", url => "http://search.cpan.org/~mstrout/" },
{ name => "List::MoreUtils", version => '0.21', url => "http://search.cpan.org/~vparseval/" },
{ name => "PDF::API2", version => '2.000', url => "http://search.cpan.org/~areibens/" },
+ { name => "Readonly", url => "http://search.cpan.org/~roode/" },
+ { name => "Rose::Object", url => "http://search.cpan.org/~jsiracusa/" },
+ { name => "Rose::DB", url => "http://search.cpan.org/~jsiracusa/" },
+ { name => "Rose::DB::Object", url => "http://search.cpan.org/~jsiracusa/" },
{ name => "Template", version => '2.18', url => "http://search.cpan.org/~abw/" },
{ name => "Text::CSV_XS", version => '0.23', url => "http://search.cpan.org/~hmbrand/" },
{ name => "Text::Iconv", version => '1.2', url => "http://search.cpan.org/~mpiotr/" },
--- /dev/null
+package SL::TransNumber;
+
+use strict;
+
+use parent qw(Rose::Object);
+
+use Carp;
+use List::MoreUtils qw(any none);
+use Readonly;
+use SL::DBUtils;
+
+use Rose::Object::MakeMethods::Generic
+(
+ scalar => [ qw(type id number save dbh dbh_provided) ],
+);
+
+# has 'type' => ( is => 'rw', required => 1 );
+# has 'id' => ( is => 'rw' );
+# has 'number' => ( is => 'rw' );
+# has 'save' => ( is => 'rw', default => 1 );
+# has 'dbh' => ( is => 'rw' );
+# has 'dbh_provided' => ( is => 'rw' );
+
+Readonly my @SUPPORTED_TYPES => qw(invoice credit_note customer vendor sales_delivery_order purchase_delivery_order sales_order purchase_order sales_quotation request_quotation);
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+
+ croak "Invalid type " . $self->type if none { $_ eq $self->type } @SUPPORTED_TYPES;
+
+ $self->dbh_provided($self->dbh);
+ $self->dbh($::form->get_standard_dbh) if !$self->dbh;
+ $self->save(1) unless defined $self->save;
+
+ return $self;
+}
+
+sub _get_filters {
+ my $self = shift;
+
+ my $type = $self->type;
+ my %filters = ( where => '' );
+
+ if (any { $_ eq $type } qw(invoice credit_note)) {
+ $filters{trans_number} = "invnumber";
+ $filters{numberfield} = $type eq 'credit_note' ? "cnnumber" : "invnumber";
+ $filters{table} = "ar";
+
+ } elsif (any { $_ eq $type } qw(customer vendor)) {
+ $filters{trans_number} = "${type}number";
+ $filters{numberfield} = "${type}number";
+ $filters{table} = $type;
+
+ } elsif ($type =~ /_delivery_order$/) {
+ $filters{trans_number} = "donumber";
+ $filters{numberfield} = $type eq 'sales_delivery_order' ? "sdonumber" : "pdonumber";
+ $filters{table} = "delivery_orders";
+ $filters{where} = $type =~ /^sales/ ? '(customer_id IS NOT NULL)' : '(vendor_id IS NOT NULL)';
+
+ } elsif ($type =~ /_order$/) {
+ $filters{trans_number} = "ordnumber";
+ $filters{numberfield} = $type eq 'sales_order' ? "sonumber" : "ponumber";
+ $filters{table} = "oe";
+ $filters{where} = 'NOT COALESCE(quotation, FALSE)';
+ $filters{where} .= $type =~ /^sales/ ? ' AND (customer_id IS NOT NULL)' : ' AND (vendor_id IS NOT NULL)';
+
+ } else {
+ $filters{trans_number} = "quonumber";
+ $filters{numberfield} = $type eq 'sales_quotation' ? "sqnumber" : "rfqnumber";
+ $filters{table} = "oe";
+ $filters{where} = 'COALESCE(quotation, FALSE)';
+ $filters{where} .= $type =~ /^sales/ ? ' AND (customer_id IS NOT NULL)' : ' AND (vendor_id IS NOT NULL)';
+ }
+
+ return %filters;
+}
+
+sub is_unique {
+ my $self = shift;
+
+ return undef if !$self->number;
+
+ my %filters = $self->_get_filters();
+
+ my @where;
+ my @values = ($self->number);
+
+ push @where, $filters{where} if $filters{where};
+
+ if ($self->id) {
+ push @where, qq|id <> ?|;
+ push @values, conv_i($self->id);
+ }
+
+ my $where_str = @where ? join(' AND ', map { "($_)" } @where) : '';
+ my $query = <<SQL;
+ SELECT $filters{trans_number}
+ FROM $filters{table}
+ WHERE ($filters{trans_number} = ?)
+ $where_str
+ LIMIT 1
+SQL
+ my ($existing_number) = selectfirst_array_query($main::form, $self->dbh, $query, @values);
+
+ return $existing_number ? 0 : 1;
+}
+
+sub create_unique {
+ my $self = shift;
+
+ my $form = $main::form;
+ my %filters = $self->_get_filters();
+
+ do_query($form, $self->dbh, qq|LOCK TABLE defaults|);
+
+ my $where = $filters{where} ? ' WHERE ' . $filters{where} : '';
+ my $query = <<SQL;
+ SELECT DISTINCT $filters{trans_number}, 1 AS in_use
+ FROM $filters{table}
+ $where
+SQL
+
+ my %numbers_in_use = selectall_as_map($form, $self->dbh, $query, $filters{trans_number}, 'in_use');
+
+ my ($number) = selectfirst_array_query($form, $self->dbh, qq|SELECT $filters{numberfield} FROM defaults|);
+ $number ||= '';
+
+ do {
+ if ($number =~ m/\d+$/) {
+ my $new_number = substr($number, $-[0]) * 1 + 1;
+ my $len_diff = length($number) - $-[0] - length($new_number);
+ $number = substr($number, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_number;
+
+ } else {
+ $number = $number . '1';
+ }
+ } while ($numbers_in_use{$number});
+
+ if ($self->save) {
+ do_query($form, $self->dbh, qq|UPDATE defaults SET $filters{numberfield} = ?|, $number);
+ $self->dbh->commit if !$self->dbh_provided;
+ }
+
+ return $number;
+}
+
+1;
projects / kivitendo-erp.git / commitdiff