From: Moritz Bunkus Date: Wed, 29 Dec 2010 09:51:38 +0000 (+0100) Subject: Merge branch 'master' of ssh://lx-office.linet-services.de/~/lx-office-erp X-Git-Tag: release-2.6.2beta1~42^2~6 X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/commitdiff_plain/abd6359e164d3e7eaffd45a2549ee1e6c167f995?hp=f00d7ebe7c70add2e433d0000c2f88f0e5842538 Merge branch 'master' of ssh://lx-office.linet-services.de/~/lx-office-erp --- diff --git a/SL/IS.pm b/SL/IS.pm index e9e4711b1..3896277c9 100644 --- a/SL/IS.pm +++ b/SL/IS.pm @@ -46,6 +46,7 @@ use SL::GenericTranslations; use SL::MoreCommon; use SL::IC; use SL::IO; +use SL::TransNumber; use Data::Dumper; use strict; @@ -515,7 +516,7 @@ sub post_invoice { 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; @@ -538,6 +539,9 @@ sub post_invoice { &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); diff --git a/SL/InstallationCheck.pm b/SL/InstallationCheck.pm index 15db0cb70..c395f1de5 100644 --- a/SL/InstallationCheck.pm +++ b/SL/InstallationCheck.pm @@ -20,6 +20,10 @@ BEGIN { { 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/" }, diff --git a/SL/TransNumber.pm b/SL/TransNumber.pm new file mode 100644 index 000000000..14795e4f7 --- /dev/null +++ b/SL/TransNumber.pm @@ -0,0 +1,148 @@ +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 = <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 = <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; diff --git a/doc/INSTALL.texi b/doc/INSTALL.texi index 7368d95f8..2f7437dd5 100644 --- a/doc/INSTALL.texi +++ b/doc/INSTALL.texi @@ -80,6 +80,14 @@ List::MoreUtils @item PDF::API2 @item +Readonly (benötigt) und Readonly::XS (optional) +@item +Rose::Object +@item +Rose::DB +@item +Rose::DB::Object +@item Template @item Text::CSV_XS diff --git a/doc/INSTALL.txt b/doc/INSTALL.txt index 92c59f99e..0518df082 100644 --- a/doc/INSTALL.txt +++ b/doc/INSTALL.txt @@ -72,6 +72,14 @@ Bestandteil einer Standard-Perl-Installation sind: * PDF::API2 + * Readonly (benötigt) und Readonly::XS (optional) + + * Rose::Object + + * Rose::DB + + * Rose::DB::Object + * Template * Text::CSV_XS diff --git a/doc/INSTALL/Ben_00c3_00b6tigte-Software-und-Pakete.html b/doc/INSTALL/Ben_00c3_00b6tigte-Software-und-Pakete.html index a852abace..90c9a2021 100644 --- a/doc/INSTALL/Ben_00c3_00b6tigte-Software-und-Pakete.html +++ b/doc/INSTALL/Ben_00c3_00b6tigte-Software-und-Pakete.html @@ -48,6 +48,10 @@ Up: Top
  • Email::Address
  • List::MoreUtils
  • PDF::API2 +
  • Readonly (benötigt) und Readonly::XS (optional) +
  • Rose::Object +
  • Rose::DB +
  • Rose::DB::Object
  • Template
  • Text::CSV_XS
  • Text::Iconv diff --git a/doc/UPGRADE b/doc/UPGRADE index 190181850..6f9a9ec5f 100644 --- a/doc/UPGRADE +++ b/doc/UPGRADE @@ -4,6 +4,30 @@ Wichtige Hinweise zum Upgrade von älteren Versionen ** BITTE FERTIGEN SIE VOR DEM UPGRADE EIN BACKUP IHRER DATENBANK(EN) AN! ** +Upgrade auf v2.6.2 +================== + + Vor dem Einloggen + ----------------- + +Mit Version 2.6.2 sind einige Abhängigkeiten von Perl-Modulen hinzugekommen. +Bitte führen sie vor dem ersten Aufrufen der einmal den folgenden Befehl im +Lx-Office Verzeichnis aus: + +$ scripts/installation_check.pl + +Sollten Module als fehlend markiert sein, folgen Sie bitte den Anweisungen in +der Installationsanweisung. + +Zumindest folgende Module sind neu benötigt: + +* Readonly (optional mit Begleitermodul Readonly::XS) +* Rose::Object, Rose::DB und Rose::DB::Object (die Installation von + Rose::DB::Object via CPAN oder den Paketmechanismus Ihrer + Distribution sollte für die automatische Installation der anderen + zwei Pakete sorgen) + + Upgrade auf v2.6.1 ==================