X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FCommon.pm;h=dc1cc04ecb94b13e81922f003f1231fa321bb726;hb=937e37ad007405c6a3a389ee18006379ffecc073;hp=43b9aaab7e5c1f550e67b03d3c402b40a8aaffbe;hpb=900dff5fd67e8ffd81beef6c2c83d155682c17fd;p=kivitendo-erp.git diff --git a/SL/Common.pm b/SL/Common.pm index 43b9aaab7..dc1cc04ec 100644 --- a/SL/Common.pm +++ b/SL/Common.pm @@ -8,11 +8,15 @@ package Common; +use utf8; +use strict; + use Time::HiRes qw(gettimeofday); +use Data::Dumper; use SL::DBUtils; -use vars qw(@db_encodings %db_encoding_to_charset); +use vars qw(@db_encodings %db_encoding_to_charset %charset_to_db_encoding); @db_encodings = ( { "label" => "ASCII", "dbencoding" => "SQL_ASCII", "charset" => "ASCII" }, @@ -29,6 +33,7 @@ use vars qw(@db_encodings %db_encoding_to_charset); ); %db_encoding_to_charset = map { $_->{dbencoding}, $_->{charset} } @db_encodings; +%charset_to_db_encoding = map { $_->{charset}, $_->{dbencoding} } @db_encodings; use constant DEFAULT_CHARSET => 'ISO-8859-15'; @@ -38,7 +43,22 @@ sub unique_id { } sub tmpname { - return "/tmp/lx-office-tmp-" . unique_id(); + return "/tmp/kivitendo-tmp-" . unique_id(); +} + +sub truncate { + my ($text, %params) = @_; + + $params{at} //= 50; + $params{at} = 3 if 3 > $params{at}; + + $params{strip} //= ''; + + $text =~ s/[\r\n]+$//g if $params{strip} =~ m/^(?: 1 | newlines? | full )$/x; + $text =~ s/[\r\n]+/ /g if $params{strip} =~ m/^(?: newlines? | full )$/x; + + return $text if length($text) <= $params{at}; + return substr($text, 0, $params{at} - 3) . '...'; } sub retrieve_parts { @@ -49,21 +69,33 @@ sub retrieve_parts { my $dbh = $form->dbconnect($myconfig); my (@filter_values, $filter); - if ($form->{"partnumber"}) { - $filter .= qq| AND (partnumber ILIKE ?)|; - push(@filter_values, '%' . $form->{"partnumber"} . '%'); + + foreach (qw(partnumber description ean)) { + next unless $form->{$_}; + + $filter .= qq| AND ($_ ILIKE ?)|; + push @filter_values, '%' . $form->{$_} . '%'; } - if ($form->{"description"}) { - $filter .= qq| AND (description ILIKE ?)|; - push(@filter_values, '%' . $form->{"description"} . '%'); + + if ($form->{no_assemblies}) { + $filter .= qq| AND (NOT COALESCE(assembly, FALSE))|; + } + if ($form->{assemblies}) { + $filter .= qq| AND assembly=TRUE|; + } + + if ($form->{no_services}) { + $filter .= qq| AND (inventory_accno_id is not NULL or assembly=TRUE)|; } + substr($filter, 1, 3) = "WHERE" if ($filter); $order_by =~ s/[^a-zA-Z_]//g; $order_dir = $order_dir ? "ASC" : "DESC"; my $query = - qq|SELECT id, partnumber, description | . + qq|SELECT id, partnumber, description, ean, | . + qq| warehouse_id, bin_id | . qq|FROM parts $filter | . qq|ORDER BY $order_by $order_dir|; my $sth = $dbh->prepare($query); @@ -154,6 +186,69 @@ sub retrieve_employees { return $employees; } +sub retrieve_customers_or_vendors { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir, $is_vendor, $allow_both) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"name"}) { + $filter .= " AND (TABLE.name ILIKE ?)"; + push(@filter_values, '%' . $form->{"name"} . '%'); + } + if (!$form->{"obsolete"}) { + $filter .= " AND NOT TABLE.obsolete"; + } + substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my (@queries, @query_parameters); + + if ($allow_both || !$is_vendor) { + my $c_filter = $filter; + $c_filter =~ s/TABLE/c/g; + push(@queries, qq|SELECT + c.id, c.name, 0 AS customer_is_vendor, + c.street, c.zipcode, c.city, + ct.cp_gender, ct.cp_title, ct.cp_givenname, ct.cp_name + FROM customer c + LEFT JOIN contacts ct ON (c.id = ct.cp_cv_id) + $c_filter|); + push(@query_parameters, @filter_values); + } + + if ($allow_both || $is_vendor) { + my $v_filter = $filter; + $v_filter =~ s/TABLE/v/g; + push(@queries, qq|SELECT + v.id, v.name, 1 AS customer_is_vendor, + v.street, v.zipcode, v.city, + ct.cp_gender, ct.cp_title, ct.cp_givenname, ct.cp_name + FROM vendor v + LEFT JOIN contacts ct ON (v.id = ct.cp_cv_id) + $v_filter|); + push(@query_parameters, @filter_values); + } + + my $query = join(" UNION ", @queries) . " ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute(@query_parameters) || $form->dberror($query . " (" . join(", ", @query_parameters) . ")"); + my $customers = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$customers}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $customers; +} + sub retrieve_delivery_customer { $main::lxdebug->enter_sub(); @@ -208,8 +303,9 @@ sub retrieve_vendor { my $query = qq!SELECT id, name, customernumber, (street || ', ' || zipcode || city) AS address FROM customer ! . - qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = 'Händler') ! . + qq!WHERE $filter business_id = (SELECT id FROM business WHERE description = ?') ! . qq!ORDER BY $order_by $order_dir!; + push @filter_values, $::locale->{iconv_utf8}->convert('Händler'); my $sth = $dbh->prepare($query); $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); @@ -256,7 +352,7 @@ sub webdav_folder { my ($form) = @_; return $main::lxdebug->leave_sub() - unless ($main::webdav && $form->{id}); + unless ($::lx_office_conf{features}->{webdav} && $form->{id}); my ($path, $number); @@ -270,6 +366,10 @@ sub webdav_folder { ($path, $number) = ("anfragen", $form->{quonumber}); } elsif ($form->{type} eq "purchase_order") { ($path, $number) = ("lieferantenbestellungen", $form->{ordnumber}); + } elsif ($form->{type} eq "sales_delivery_order") { + ($path, $number) = ("verkaufslieferscheine", $form->{donumber}); + } elsif ($form->{type} eq "purchase_delivery_order") { + ($path, $number) = ("einkaufslieferscheine", $form->{donumber}); } elsif ($form->{type} eq "credit_note") { ($path, $number) = ("gutschriften", $form->{invnumber}); } elsif ($form->{vc} eq "customer") { @@ -288,11 +388,10 @@ sub webdav_folder { mkdir_with_parents($path); } else { - my $base_path = substr($ENV{'SCRIPT_NAME'}, 1); + my $base_path = $ENV{'SCRIPT_NAME'}; $base_path =~ s|[^/]+$||; - $base_path =~ s|/$||; - - if (opendir $dir, $path) { + # wo kommt der wert für dir her? es wird doch gar nichts übergeben? fix für strict my $dir jb 21.2. + if (opendir my $dir, $path) { foreach my $file (sort { lc $a cmp lc $b } readdir $dir) { next if (($file eq '.') || ($file eq '..')); @@ -306,7 +405,7 @@ sub webdav_folder { push @{ $form->{WEBDAV} }, { 'name' => $fname, - 'link' => ($ENV{"HTTPS"} ? "https://" : "http://") . $ENV{'SERVER_NAME'} . "/$base_path/$file", + 'link' => $base_path . $file, 'type' => $is_directory ? $main::locale->text('Directory') : $main::locale->text('File'), }; } @@ -358,6 +457,9 @@ sub get_vc_details { $query = qq|SELECT * FROM contacts WHERE (cp_cv_id = ?)|; $form->{CONTACTS} = selectall_hashref_query($form, $dbh, $query, $vc_id); + # Only show default pricegroup for customer, not vendor, which is why this is outside the main query + ($form->{pricegroup}) = selectrow_query($form, $dbh, qq|SELECT pricegroup FROM pricegroup WHERE id = ?|, $form->{klass}); + $dbh->disconnect(); $main::lxdebug->leave_sub(); @@ -400,6 +502,8 @@ sub save_email_status { } elsif ($form->{script} eq 'ir.pl') { $table = 'ap'; + } elsif ($form->{script} eq 'do.pl') { + $table = 'delivery_orders'; } return $main::lxdebug->leave_sub() if (!$form->{id} || !$table || !$form->{formname}); @@ -413,8 +517,8 @@ sub save_email_status { $intnotes .= "\n\n" if ($intnotes); - my $cc = $main::locale->text('Cc') . ": $form->{cc}\n" if $form->{cc}; - my $bcc = $main::locale->text('Bcc') . ": $form->{bcc}\n" if $form->{bcc}; + my $cc = $form->{cc} ? $main::locale->text('Cc') . ": $form->{cc}\n" : ''; + my $bcc = $form->{bcc} ? $main::locale->text('Bcc') . ": $form->{bcc}\n" : ''; my $now = scalar localtime; $intnotes .= $main::locale->text('[email]') . "\n" @@ -439,11 +543,97 @@ sub check_params { my $params = shift; foreach my $key (@_) { - if (!defined $params->{$key}) { + if ((ref $key eq '') && !defined $params->{$key}) { my $subroutine = (caller(1))[3]; + $main::lxdebug->message(LXDebug->BACKTRACE_ON_ERROR, "[Common::check_params] failed, params object dumped below"); + $main::lxdebug->message(LXDebug->BACKTRACE_ON_ERROR, Dumper($params)); $main::form->error($main::locale->text("Missing parameter #1 in call to sub #2.", $key, $subroutine)); + + } elsif (ref $key eq 'ARRAY') { + my $found = 0; + foreach my $subkey (@{ $key }) { + if (defined $params->{$subkey}) { + $found = 1; + last; + } + } + + if (!$found) { + my $subroutine = (caller(1))[3]; + $main::lxdebug->message(LXDebug->BACKTRACE_ON_ERROR, "[Common::check_params] failed, params object dumped below"); + $main::lxdebug->message(LXDebug->BACKTRACE_ON_ERROR, Dumper($params)); + $main::form->error($main::locale->text("Missing parameter (at least one of #1) in call to sub #2.", join(', ', @{ $key }), $subroutine)); + } + } + } +} + +sub check_params_x { + my $params = shift; + + foreach my $key (@_) { + if ((ref $key eq '') && !exists $params->{$key}) { + my $subroutine = (caller(1))[3]; + $main::form->error($main::locale->text("Missing parameter #1 in call to sub #2.", $key, $subroutine)); + + } elsif (ref $key eq 'ARRAY') { + my $found = 0; + foreach my $subkey (@{ $key }) { + if (exists $params->{$subkey}) { + $found = 1; + last; + } + } + + if (!$found) { + my $subroutine = (caller(1))[3]; + $main::form->error($main::locale->text("Missing parameter (at least one of #1) in call to sub #2.", join(', ', @{ $key }), $subroutine)); + } } } } 1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +Common - Common routines used in a lot of places. + +=head1 SYNOPSIS + + my $short_text = Common::truncate($long_text, at => 10); + +=head1 FUNCTIONS + +=over 4 + +=item C + +Truncates C<$text> at a position and insert an ellipsis if the text is +longer. The maximum number of characters to return is given with the +paramter C which defaults to 50. + +The optional parameter C can be used to remove unwanted line +feed/carriage return characters from the text before truncation. It +can be set to C<1> (only strip those at the end of C<$text>) or +C (replace consecutive line feed/carriage return characters in +the middle by a single space and remove tailing line feed/carriage +return characters). + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE, +Sven Schöling Es.schoeling@linet-services.deE + +=cut