X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/7c3117b50d46f04f589aae322525f0797c4146e9..e14cb525c640cb15bb6b2dfb62ccebbe78cb45cd:/SL/Form.pm diff --git a/SL/Form.pm b/SL/Form.pm index 5e0b9fd53..514c282d2 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -36,123 +36,150 @@ #====================================================================== package Form; + use Data::Dumper; +use CGI; use Cwd; -use HTML::Template; -use SL::Template; -use CGI::Ajax; +use Encode; +use File::Copy; +use IO::File; +use SL::Auth; +use SL::Auth::DB; +use SL::Auth::LDAP; +use SL::AM; +use SL::Common; +use SL::CVar; +use SL::DB; +use SL::DBConnect; use SL::DBUtils; +use SL::DO; +use SL::IC; +use SL::IS; +use SL::Locale; +use SL::Mailer; use SL::Menu; +use SL::MoreCommon qw(uri_encode uri_decode); +use SL::OE; +use SL::Request; +use SL::Template; use SL::User; -use CGI; +use SL::X; +use Template; +use URI; +use List::Util qw(first max min sum); +use List::MoreUtils qw(all any apply); -sub _input_to_hash { - $main::lxdebug->enter_sub(2); +use strict; + +my $standard_dbh; + +END { + disconnect_standard_dbh(); +} + +sub disconnect_standard_dbh { + return unless $standard_dbh; + $standard_dbh->disconnect(); + undef $standard_dbh; +} + +sub new { + $main::lxdebug->enter_sub(); + + my $type = shift; - my $input = $_[0]; - my %in = (); - my @pairs = split(/&/, $input); + my $self = {}; - foreach (@pairs) { - my ($name, $value) = split(/=/, $_, 2); - $in{$name} = unescape(undef, $value); + no warnings 'once'; + if ($LXDebug::watch_form) { + require SL::Watchdog; + tie %{ $self }, 'SL::Watchdog'; } - $main::lxdebug->leave_sub(2); + bless $self, $type; + + open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file + $self->{version} = ; + close VERSION_FILE; + $self->{version} =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code. + + $main::lxdebug->leave_sub(); + + return $self; +} - return %in; +sub read_cgi_input { + my ($self) = @_; + SL::Request::read_cgi_input($self); } -sub _request_to_hash { +sub _flatten_variables_rec { $main::lxdebug->enter_sub(2); - my ($input) = @_; - my ($i, $loc, $key, $val); - my (%ATTACH, $f, $header, $header_body, $len, $buf); - my ($boundary, @list, $size, $body, $x, $blah, $name); - - if ($ENV{'CONTENT_TYPE'} - && ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/)) { - $boundary = quotemeta('--' . $1); - @list = split(/$boundary/, $input); - - # For some reason there are always 2 extra, that are empty - $size = @list - 2; - - for ($x = 1; $x <= $size; $x++) { - $header_body = $list[$x]; - $header_body =~ /\r\n\r\n|\n\n/; - - # Here we split the header and body - $header = $`; - $body = $'; #' - $body =~ s/\r\n$//; - - # Now we try to get the file name - $name = $header; - $name =~ /name=\"(.+)\"/; - ($name, $blah) = split(/\"/, $1); - - # If the form name is not attach, then we need to parse this like - # regular form data - if ($name ne "attach") { - $body =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; - $ATTACH{$name} = $body; - - # Otherwise it is an attachment and we need to finish it up - } elsif ($name eq "attach") { - $header =~ /filename=\"(.+)\"/; - $ATTACH{'FILE_NAME'} = $1; - $ATTACH{'FILE_NAME'} =~ s/\"//g; - $ATTACH{'FILE_NAME'} =~ s/\s//g; - $ATTACH{'FILE_CONTENT'} = $body; - - for ($i = $x; $list[$i]; $i++) { - $list[$i] =~ s/^.+name=$//; - $list[$i] =~ /\"(\w+)\"/; - $ATTACH{$1} = $'; #' - } - } + my $self = shift; + my $curr = shift; + my $prefix = shift; + my $key = shift; + + my @result; + + if ('' eq ref $curr->{$key}) { + @result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} }); + + } elsif ('HASH' eq ref $curr->{$key}) { + foreach my $hash_key (sort keys %{ $curr->{$key} }) { + push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key); } - $main::lxdebug->leave_sub(2); - return %ATTACH; + } else { + foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) { + my $first_array_entry = 1; - } else { - $main::lxdebug->leave_sub(2); - return _input_to_hash($input); + foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) { + push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key); + $first_array_entry = 0; + } + } } -} -sub new { - $main::lxdebug->enter_sub(); + $main::lxdebug->leave_sub(2); - my $type = shift; + return @result; +} - my $self = {}; +sub flatten_variables { + $main::lxdebug->enter_sub(2); - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + my $self = shift; + my @keys = @_; - if ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + my @variables; - if ($ARGV[0]) { - $_ = $ARGV[0]; + foreach (@keys) { + push @variables, $self->_flatten_variables_rec($self, '', $_); } - my %parameters = _request_to_hash($_); - map({ $self->{$_} = $parameters{$_}; } keys(%parameters)); + $main::lxdebug->leave_sub(2); - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|\#)/_/g; + return @variables; +} - $self->{version} = "2.4.2"; +sub flatten_standard_variables { + $main::lxdebug->enter_sub(2); - $main::lxdebug->leave_sub(); + my $self = shift; + my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_); - bless $self, $type; + my @variables; + + foreach (grep { ! $skip_keys{$_} } keys %{ $self }) { + push @variables, $self->_flatten_variables_rec($self, '', $_); + } + + $main::lxdebug->leave_sub(2); + + return @variables; } sub debug { @@ -167,114 +194,100 @@ sub debug { $main::lxdebug->leave_sub(); } -sub escape { +sub dumper { $main::lxdebug->enter_sub(2); - my ($self, $str, $beenthere) = @_; + my $self = shift; + my $password = $self->{password}; + + $self->{password} = 'X' x 8; - # for Apache 2 we escape strings twice - #if (($ENV{SERVER_SOFTWARE} =~ /Apache\/2/) && !$beenthere) { - # $str = $self->escape($str, 1); - #} + local $Data::Dumper::Sortkeys = 1; + my $output = Dumper($self); - $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; + $self->{password} = $password; $main::lxdebug->leave_sub(2); - return $str; + return $output; } -sub unescape { - $main::lxdebug->enter_sub(2); - +sub escape { my ($self, $str) = @_; - $str =~ tr/+/ /; - $str =~ s/\\$//; - - $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; + return uri_encode($str); +} - $main::lxdebug->leave_sub(2); +sub unescape { + my ($self, $str) = @_; - return $str; + return uri_decode($str); } sub quote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { $str =~ s/\"/"/g; } - $str; + $main::lxdebug->leave_sub(); + return $str; } sub unquote { + $main::lxdebug->enter_sub(); my ($self, $str) = @_; if ($str && !ref($str)) { $str =~ s/"/\"/g; } - $str; - -} - -sub quote_html { - $main::lxdebug->enter_sub(2); - - my ($self, $str) = @_; - - my %replace = - ('order' => ['"', '<', '>'], - '<' => '<', - '>' => '>', - '"' => '"', - ); - - map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); - - $main::lxdebug->leave_sub(2); + $main::lxdebug->leave_sub(); return $str; } sub hide_form { + $main::lxdebug->enter_sub(); my $self = shift; if (@_) { - for (@_) { - print qq|\n|; - } + map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_); } else { - delete $self->{header}; for (sort keys %$self) { - print qq|\n|; + next if (($_ eq "header") || (ref($self->{$_}) ne "")); + print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } } + $main::lxdebug->leave_sub(); +} +sub throw_on_error { + my ($self, $code) = @_; + local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) }; + $code->(); } sub error { $main::lxdebug->enter_sub(); + $main::lxdebug->show_backtrace(); + my ($self, $msg) = @_; - if ($ENV{HTTP_USER_AGENT}) { + + if ($self->{__ERROR_HANDLER}) { + $self->{__ERROR_HANDLER}->($msg); + + } elsif ($ENV{HTTP_USER_AGENT}) { $msg =~ s/\n/
/g; $self->show_generic_error($msg); } else { - - if ($self->{error_function}) { - &{ $self->{error_function} }($msg); - } else { - die "Error: $msg\n"; - } + print STDERR "Error: $msg\n"; + ::end_of_request(); } $main::lxdebug->leave_sub(); @@ -290,13 +303,22 @@ sub info { if (!$self->{header}) { $self->header; - print qq| - |; + print qq||; } print qq| - -

$msg +

$msg

+ + + + |; } else { @@ -311,20 +333,20 @@ sub info { $main::lxdebug->leave_sub(); } +# calculates the number of rows in a textarea based on the content and column number +# can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); + my ($self, $str, $cols, $maxrows, $minrows) = @_; - my ($self, $str, $cols, $maxrows) = @_; + $minrows ||= 1; - my $rows = 0; - - map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; - - $maxrows = $rows unless defined $maxrows; + my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; + $maxrows ||= $rows; $main::lxdebug->leave_sub(); - return ($rows > $maxrows) ? $maxrows : $rows; + return max(min($rows, $maxrows), $minrows); } sub dberror { @@ -342,156 +364,246 @@ sub isblank { my ($self, $name, $msg) = @_; - if ($self->{$name} =~ /^\s*$/) { - $self->error($msg); + my $curr = $self; + foreach my $part (split m/\./, $name) { + if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) { + $self->error($msg); + } + $curr = $curr->{$part}; } + $main::lxdebug->leave_sub(); } -sub header { - $main::lxdebug->enter_sub(); +sub _get_request_uri { + my $self = shift; - my ($self, $extra_code) = @_; + return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR}; - if ($self->{header}) { - $main::lxdebug->leave_sub(); - return; - } + my $scheme = $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http'; + my $port = $ENV{SERVER_PORT} || ''; + $port = undef if (($scheme eq 'http' ) && ($port == 80)) + || (($scheme eq 'https') && ($port == 443)); - my ($stylesheet, $favicon, $charset); + my $uri = URI->new("${scheme}://"); + $uri->scheme($scheme); + $uri->port($port); + $uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR}); + $uri->path_query($ENV{REQUEST_URI}); + $uri->query(''); - if ($ENV{HTTP_USER_AGENT}) { + return $uri; +} - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = - qq| - |; - } +sub _add_to_request_uri { + my $self = shift; - $self->{favicon} = "favicon.ico" unless $self->{favicon}; + my $relative_new_path = shift; + my $request_uri = shift || $self->_get_request_uri; + my $relative_new_uri = URI->new($relative_new_path); + my @request_segments = $request_uri->path_segments; - if ($self->{favicon} && (-f "$self->{favicon}")) { - $favicon = - qq| - |; - } + my $new_uri = $request_uri->clone; + $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); - if ($self->{charset}) { - $charset = - qq| - |; - } - if ($self->{landscape}) { - $pagelayout = qq||; - } - if ($self->{fokus}) { - $fokus = qq||; - } + return $new_uri; +} - #Set Calendar - my $jsscript = ""; - if ($self->{jsscript} == 1) { +sub create_http_response { + $main::lxdebug->enter_sub(); - $jsscript = qq| - - - - - $self->{javascript} - |; - } + my $self = shift; + my %params = @_; + + my $cgi = $::request->{cgi}; + + my $session_cookie; + if (defined $main::auth) { + my $uri = $self->_get_request_uri; + my @segments = $uri->path_segments; + pop @segments; + $uri->path_segments(@segments); - $self->{titlebar} = - ($self->{title}) - ? "$self->{title} - $self->{titlebar}" - : $self->{titlebar}; - my $ajax = ""; - foreach $item (@ { $self->{AJAX} }) { - $ajax .= $item->show_javascript(); + my $session_cookie_value = $main::auth->get_session_id(); + + if ($session_cookie_value) { + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $uri->path, + '-secure' => $ENV{HTTPS}); } - print qq|Content-Type: text/html + } + + my %cgi_params = ('-type' => $params{content_type}); + $cgi_params{'-charset'} = $params{charset} if ($params{charset}); + $cgi_params{'-cookie'} = $session_cookie if ($session_cookie); + + map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length); + + my $output = $cgi->header(%cgi_params); + + $main::lxdebug->leave_sub(); + + return $output; +} +sub header { + $::lxdebug->enter_sub; + + my ($self, %params) = @_; + my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; + my @header; + + my $layout = $::request->{layout}; + + $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++; + + # standard css for all + $layout->use_stylesheet("$_.css") for qw( + main menu tabcontent list_accounts jquery.autocomplete + jquery.multiselect2side frame_header/header + ui-lightness/jquery-ui-1.8.12.custom + js/jscalendar/calendar-win2k-1 + ); + + $layout->use_javascript("$_.js") for qw( + jquery common jscalendar/calendar jscalendar/lang/calendar-de + jscalendar/calendar-setup part_selection jquery-ui jquery.cookie jqModal + switchmenuframe + ); + + $self->{favicon} ||= "favicon.ico"; + $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title}; + + # build includes + if ($self->{refresh_url} || $self->{refresh_time}) { + my $refresh_time = $self->{refresh_time} || 3; + my $refresh_url = $self->{refresh_url} || $ENV{REFERER}; + push @header, ""; + } + + push @header, map { qq|| } $layout->stylesheets; + push @header, " " if $self->{landscape}; + push @header, "" if -f $self->{favicon}; + push @header, map { qq|| } $layout->javascripts; + push @header, $self->{javascript} if $self->{javascript}; + push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; + + my %doctypes = ( + strict => qq||, + transitional => qq||, + frameset => qq||, + html5 => qq||, + ); + + # output + print $self->create_http_response(content_type => 'text/html', charset => $db_charset); + print $doctypes{$params{doctype} || 'transitional'}, $/; + print < - + + $self->{titlebar} - $stylesheet - $pagelayout - $favicon - $charset - $jsscript - $ajax - $fokus - - - - +EOT + print " $_\n" for @header; + print < + + - $extra_code - +EOT + print $::request->{layout}->pre_content; + print $::request->{layout}->start_content; -|; + $layout->header_done; + + $::lxdebug->leave_sub; +} + +sub footer { + return unless $::request->{layout}->need_footer; + + print $::request->{layout}->end_content; + print $::request->{layout}->post_content; + + if (my @inline_scripts = $::request->{layout}->javascripts_inline) { + print "\n"; } - $self->{header} = 1; + + print < + +EOL +} + +sub ajax_response_header { + $main::lxdebug->enter_sub(); + + my ($self) = @_; + + my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; + my $output = $::request->{cgi}->header('-charset' => $db_charset); $main::lxdebug->leave_sub(); + + return $output; } -sub parse_html_template { +sub redirect_header { + my $self = shift; + my $new_url = shift; + + my $base_uri = $self->_get_request_uri; + my $new_uri = URI->new_abs($new_url, $base_uri); + + die "Headers already sent" if $self->{header}; + $self->{header} = 1; + + return $::request->{cgi}->redirect($new_uri); +} + +sub set_standard_title { + $::lxdebug->enter_sub; + my $self = shift; + + $self->{titlebar} = "kivitendo " . $::locale->text('Version') . " $self->{version}"; + $self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name}; + $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name}; + + $::lxdebug->leave_sub; +} + +sub _prepare_html_template { $main::lxdebug->enter_sub(); my ($self, $file, $additional_params) = @_; my $language; - if (!defined($main::myconfig) || !defined($main::myconfig{"countrycode"})) { - $language = $main::language; + if (!%::myconfig || !$::myconfig{"countrycode"}) { + $language = $::lx_office_conf{system}->{language}; } else { $language = $main::myconfig{"countrycode"}; } + $language = "de" unless ($language); - if (-f "templates/webpages/${file}_${language}.html") { - if ((-f ".developer") && - (-f "templates/webpages/${file}_master.html") && - ((stat("templates/webpages/${file}_master.html"))[9] > - (stat("templates/webpages/${file}_${language}.html"))[9])) { - my $info = "Developper information: templates/webpages/${file}_master.html is newer than the localized version.\n" . - "Please re-run 'locales.pl' in 'locale/${language}'."; - print(qq|
$info
|); - die($info); - } - - $file = "templates/webpages/${file}_${language}.html"; - } elsif (-f "templates/webpages/${file}.html") { + if (-f "templates/webpages/${file}.html") { $file = "templates/webpages/${file}.html"; + } else { - my $info = "Web page template '${file}' not found.\n" . - "Please re-run 'locales.pl' in 'locale/${language}'."; - print(qq|
$info
|); - die($info); + my $info = "Web page template '${file}' not found.\n"; + print qq|
$info
|; + ::end_of_request(); } - my $template = HTML::Template->new("filename" => $file, - "die_on_bad_params" => 0, - "strict" => 0, - "case_sensitive" => 1, - "loop_context_vars" => 1, - "global_vars" => 1); - - $additional_params = {} unless ($additional_params); if ($self->{"DEBUG"}) { $additional_params->{"DEBUG"} = $self->{"DEBUG"}; } @@ -502,69 +614,148 @@ sub parse_html_template { } if (%main::myconfig) { - map({ $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys(%main::myconfig)); - my $jsc_dateformat = $main::myconfig{"dateformat"}; - $jsc_dateformat =~ s/d+/\%d/gi; - $jsc_dateformat =~ s/m+/\%m/gi; - $jsc_dateformat =~ s/y+/\%Y/gi; - $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat; + $::myconfig{jsc_dateformat} = apply { + s/d+/\%d/gi; + s/m+/\%m/gi; + s/y+/\%Y/gi; + } $::myconfig{"dateformat"}; + $additional_params->{"myconfig"} ||= \%::myconfig; + map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig; + } + + $additional_params->{"conf_dbcharset"} = $::lx_office_conf{system}->{dbcharset}; + $additional_params->{"conf_webdav"} = $::lx_office_conf{features}->{webdav}; + $additional_params->{"conf_latex_templates"} = $::lx_office_conf{print_templates}->{latex}; + $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument}; + $additional_params->{"conf_vertreter"} = $::lx_office_conf{features}->{vertreter}; + $additional_params->{"conf_show_best_before"} = $::lx_office_conf{features}->{show_best_before}; + $additional_params->{"conf_parts_image_css"} = $::lx_office_conf{features}->{parts_image_css}; + $additional_params->{"conf_parts_listing_images"} = $::lx_office_conf{features}->{parts_listing_images}; + $additional_params->{"conf_parts_show_image"} = $::lx_office_conf{features}->{parts_show_image}; + $additional_params->{"conf_payments_changeable"} = $::lx_office_conf{features}->{payments_changeable}; + $additional_params->{"INSTANCE_CONF"} = $::instance_conf; + + if (my $debug_options = $::lx_office_conf{debug}{options}) { + map { $additional_params->{'DEBUG_' . uc($_)} = $debug_options->{$_} } keys %$debug_options; + } + + if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) { + while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) { + $additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value; + } } - $additional_params->{"conf_jscalendar"} = $main::jscalendar; - $additional_params->{"conf_lizenzen"} = $main::lizenzen; - $additional_params->{"conf_latex_templates"} = $main::latex; - $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates; + $main::lxdebug->leave_sub(); + + return $file; +} - my @additional_param_names = keys(%{$additional_params}); - foreach my $key ($template->param()) { - my $param = $self->{$key}; - $param = $additional_params->{$key} if (grep(/^${key}$/, @additional_param_names)); - $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY")); - $template->param($key => $param); - } +sub parse_html_template { + $main::lxdebug->enter_sub(); + + my ($self, $file, $additional_params) = @_; + + $additional_params ||= { }; - my $output = $template->output(); + my $real_file = $self->_prepare_html_template($file, $additional_params); + my $template = $self->template || $self->init_template; + + map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; + + my $output; + $template->process($real_file, $additional_params, \$output) || die $template->error; $main::lxdebug->leave_sub(); return $output; } +sub init_template { + my $self = shift; + + return $self->template if $self->template; + + # Force scripts/locales.pl to pick up the exception handling template. + # parse_html_template('generic/exception') + return $self->template(Template->new({ + 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', + 'COMPILE_EXT' => '.tcc', + 'COMPILE_DIR' => $::lx_office_conf{paths}->{userspath} . '/templates-cache', + 'ERROR' => 'templates/webpages/generic/exception.html', + })) || die; +} + +sub template { + my $self = shift; + $self->{template_object} = shift if @_; + return $self->{template_object}; +} + sub show_generic_error { - my ($self, $error, $title, $action) = @_; + $main::lxdebug->enter_sub(); + + my ($self, $error, %params) = @_; + + if ($self->{__ERROR_HANDLER}) { + $self->{__ERROR_HANDLER}->($error); + $main::lxdebug->leave_sub(); + return; + } - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_error"} = $error; + my $add_params = { + 'title_error' => $params{title}, + 'label_error' => $error, + }; + + if ($params{action}) { + my @vars; + + map { delete($self->{$_}); } qw(action); + map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self }; + + $add_params->{SHOW_BUTTON} = 1; + $add_params->{BUTTON_LABEL} = $params{label} || $params{action}; + $add_params->{VARIABLES} = \@vars; - my @vars; - if ($action) { - map({ delete($self->{$_}); } qw(action)); - map({ push(@vars, { "name" => $_, "value" => $self->{$_} }) - if (!ref($self->{$_})); } - keys(%{$self})); - $add_params->{"SHOW_BUTTON"} = 1; - $add_params->{"BUTTON_LABEL"} = $action; + } elsif ($params{back_button}) { + $add_params->{SHOW_BACK_BUTTON} = 1; } - $add_params->{"VARIABLES"} = \@vars; + + $self->{title} = $params{title} if $params{title}; $self->header(); - print($self->parse_html_template("generic/error", $add_params)); + print $self->parse_html_template("generic/error", $add_params); + + print STDERR "Error: $error\n"; + + $main::lxdebug->leave_sub(); - die("Error: $error\n"); + ::end_of_request(); } sub show_generic_information { - my ($self, $error, $title) = @_; + $main::lxdebug->enter_sub(); + + my ($self, $text, $title) = @_; + + my $add_params = { + 'title_information' => $title, + 'label_information' => $text, + }; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_information"} = $error; + $self->{title} = $title if ($title); $self->header(); - print($self->parse_html_template("generic/information", $add_params)); + print $self->parse_html_template("generic/information", $add_params); - die("Information: $error\n"); + $main::lxdebug->leave_sub(); + + ::end_of_request(); } # write Trigger JavaScript-Code ($qty = quantity of Triggers) @@ -580,15 +771,13 @@ sub write_trigger { # default my %dateformats = ( "dd.mm.yy" => "%d.%m.%Y", - "dd-mm-yy" => "%d-%m-%Y", "dd/mm/yy" => "%d/%m/%Y", "mm/dd/yy" => "%m/%d/%Y", - "mm-dd-yy" => "%m-%d-%Y", "yyyy-mm-dd" => "%Y-%m-%d", ); - my $ifFormat = defined($dateformats{$myconfig{"dateformat"}}) ? - $dateformats{$myconfig{"dateformat"}} : "%d.%m.%Y"; + my $ifFormat = defined($dateformats{$myconfig->{"dateformat"}}) ? + $dateformats{$myconfig->{"dateformat"}} : "%d.%m.%Y"; my @triggers; while ($#_ >= 2) { @@ -597,7 +786,7 @@ sub write_trigger { { inputField : "| . (shift) . qq|", ifFormat :"$ifFormat", - align : "| . (shift) . qq|", + align : "| . (shift) . qq|", button : "| . (shift) . qq|" } ); @@ -614,22 +803,31 @@ sub write_trigger { return $jsscript; } #end sub write_trigger +sub _store_redirect_info_in_session { + my ($self) = @_; + + return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x; + + my ($controller, $params) = ($1, $2); + my $form = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params }; + $self->{callback} = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form); +} + sub redirect { $main::lxdebug->enter_sub(); my ($self, $msg) = @_; - if ($self->{callback}) { - - ($script, $argv) = split(/\?/, $self->{callback}); - exec("perl", "$script", $argv); + if (!$self->{callback}) { + $self->info($msg); } else { - - $self->info($msg); - exit; + $self->_store_redirect_info_in_session; + print $::form->redirect_header($self->{callback}); } + ::end_of_request(); + $main::lxdebug->leave_sub(); } @@ -648,144 +846,270 @@ sub format_amount { $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount, $places, $dash) = @_; - - if ($amount eq "") { - $amount = 0; - } - my $neg = ($amount =~ s/-//); + $amount ||= 0; + $dash ||= ''; + my $neg = $amount < 0; + my $force_places = defined $places && $places >= 0; - if (defined($places) && ($places ne '')) { - if ($places < 0) { - $amount *= 1; - $places *= -1; + $amount = $self->round_amount($amount, abs $places) if $force_places; + $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa - my ($actual_places) = ($amount =~ /\.(\d+)/); - $actual_places = length($actual_places); - $places = $actual_places > $places ? $actual_places : $places; - } + # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl + # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on + # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs. - $amount = $self->round_amount($amount, $places); - } + $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars - my @p = split(/\./, $amount); # split amount at decimal point - - $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters + my @p = split(/\./, $amount); # split amount at decimal point + $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters $amount = $p[0]; - $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); + if ($places || $p[1]) { + $amount .= $d[0] + . ( $p[1] || '' ) + . (0 x (abs($places || 0) - length ($p[1]||''))); # pad the fraction + } $amount = do { - ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : - ($dash =~ /DRCR/) ? ($neg ? "$amount DR" : "$amount CR" ) : - ($neg ? "-$amount" : "$amount" ) ; + ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : + ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) : + ($neg ? "-$amount" : "$amount" ) ; }; - $main::lxdebug->leave_sub(2); return $amount; } -# -sub parse_amount { - $main::lxdebug->enter_sub(2); - my ($self, $myconfig, $amount) = @_; +sub format_amount_units { + $main::lxdebug->enter_sub(); - if ( ($myconfig->{numberformat} eq '1.000,00') - || ($myconfig->{numberformat} eq '1000,00')) { - $amount =~ s/\.//g; - $amount =~ s/,/\./; + my $self = shift; + my %params = @_; + + my $myconfig = \%main::myconfig; + my $amount = $params{amount} * 1; + my $places = $params{places}; + my $part_unit_name = $params{part_unit}; + my $amount_unit_name = $params{amount_unit}; + my $conv_units = $params{conv_units}; + my $max_places = $params{max_places}; + + if (!$part_unit_name) { + $main::lxdebug->leave_sub(); + return ''; } - if ($myconfig->{numberformat} eq "1'000.00") { - $amount =~ s/\'//g; + my $all_units = AM->retrieve_all_units; + + if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) { + $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller'); } - $amount =~ s/,//g; + if (!scalar @{ $conv_units }) { + my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name; + $main::lxdebug->leave_sub(); + return $result; + } - $main::lxdebug->leave_sub(2); + my $part_unit = $all_units->{$part_unit_name}; + my $conv_unit = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit; - return ($amount * 1); -} + $amount *= $conv_unit->{factor}; -sub round_amount { - $main::lxdebug->enter_sub(2); + my @values; + my $num; - my ($self, $amount, $places) = @_; - my $round_amount; + foreach my $unit (@$conv_units) { + my $last = $unit->{name} eq $part_unit->{name}; + if (!$last) { + $num = int($amount / $unit->{factor}); + $amount -= $num * $unit->{factor}; + } - # Rounding like "Kaufmannsrunden" - # Descr. http://de.wikipedia.org/wiki/Rundung - # Inspired by - # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html - # Solves Bug: 189 - # Udo Spallek - $amount = $amount * (10**($places)); - $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places)); + if ($last ? $amount : $num) { + push @values, { "unit" => $unit->{name}, + "amount" => $last ? $amount / $unit->{factor} : $num, + "places" => $last ? $places : 0 }; + } - $main::lxdebug->leave_sub(2); + last if $last; + } - return $round_amount; + if (!@values) { + push @values, { "unit" => $part_unit_name, + "amount" => 0, + "places" => 0 }; + } -} + my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values; -sub parse_template { - $main::lxdebug->enter_sub(); + $main::lxdebug->leave_sub(); - my ($self, $myconfig, $userspath) = @_; - my $template; + return $result; +} + +sub format_string { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $input = shift; + + $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx; + $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx; + $input =~ s/\#\#/\#/g; + + $main::lxdebug->leave_sub(2); + + return $input; +} + +# + +sub parse_amount { + $main::lxdebug->enter_sub(2); + + my ($self, $myconfig, $amount) = @_; + + if ( ($myconfig->{numberformat} eq '1.000,00') + || ($myconfig->{numberformat} eq '1000,00')) { + $amount =~ s/\.//g; + $amount =~ s/,/\./g; + } + + if ($myconfig->{numberformat} eq "1'000.00") { + $amount =~ s/\'//g; + } + + $amount =~ s/,//g; + + $main::lxdebug->leave_sub(2); + + # Make sure no code wich is not a math expression ends up in eval(). + return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x; + return scalar(eval($amount)) * 1 ; +} + +sub round_amount { + $main::lxdebug->enter_sub(2); + + my ($self, $amount, $places) = @_; + my $round_amount; + + # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung ) + + # Round amounts to eight places before rounding to the requested + # number of places. This gets rid of errors due to internal floating + # point representation. + $amount = $self->round_amount($amount, 8) if $places < 8; + $amount = $amount * (10**($places)); + $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places)); + + $main::lxdebug->leave_sub(2); + + return $round_amount; + +} + +sub parse_template { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + my ($out, $out_mode); + + local (*IN, *OUT); + + my $userspath = $::lx_office_conf{paths}->{userspath}; $self->{"cwd"} = getcwd(); $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + my $ext_for_format; + + my $template_type; if ($self->{"format"} =~ /(opendocument|oasis)/i) { - $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'OpenDocument'; + $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt'; + } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; - $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /html/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { - $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif (($self->{"format"} =~ /xml/i) || - (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif ( $self->{"format"} =~ /elsterwinston/i ) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); - } elsif ( $self->{"format"} =~ /elstertaxbird/i ) { - $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $template_type = 'LaTeX'; + $ext_for_format = 'pdf'; + + } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { + $template_type = 'HTML'; + $ext_for_format = 'html'; + + } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { + $template_type = 'XML'; + $ext_for_format = 'xml'; + + } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) { + $template_type = 'XML'; + + } elsif ( $self->{"format"} =~ /excel/i ) { + $template_type = 'Excel'; + $ext_for_format = 'xls'; + } elsif ( defined $self->{'format'}) { $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}"); + } elsif ( $self->{'format'} eq '' ) { $self->error("No Outputformat given: $self->{'format'}"); + } else { #Catch the rest - $self->error("Outputformat not defined: $self->{'format'}"); + $self->error("Outputformat not defined: $self->{'format'}"); } + my $template = SL::Template::create(type => $template_type, + file_name => $self->{IN}, + form => $self, + myconfig => $myconfig, + userspath => $userspath); + # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be. $self->{"notes"} = $self->{ $self->{"formname"} . "notes" }; - map({ $self->{"employee_${_}"} = $myconfig->{$_}; } - qw(email tel fax name signature company address businessnumber - co_ustid taxnumber duns)); - map({ $self->{"employee_${_}"} =~ s/\\n/\n/g; } - qw(company address signature)); - map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature)); + if (!$self->{employee_id}) { + map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns); + } + + map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid); + map { $self->{"myconfig_${_}"} = $myconfig->{$_} } grep { $_ ne 'dbpasswd' } keys %{ $myconfig }; $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); # OUT is used for the media, screen, printer, email # for postscript we store a copy in a temporary file - my $fileid = time; - $self->{tmpfile} = "$userspath/${fileid}.$self->{IN}" if ( $self->{tmpfile} eq '' ); + my ($temp_fh, $suffix); + $suffix = $self->{IN}; + $suffix =~ s/.*\.//; + ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile( + 'kivitendo-printXXXXXX', + SUFFIX => '.' . ($suffix || 'tex'), + DIR => $userspath, + UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1, + ); + close $temp_fh; + if ($template->uses_temp_file() || $self->{media} eq 'email') { - $out = $self->{OUT}; - $self->{OUT} = ">$self->{tmpfile}"; + $out = $self->{OUT}; + $out_mode = $self->{OUT_MODE} || '>'; + $self->{OUT} = "$self->{tmpfile}"; + $self->{OUT_MODE} = '>'; } + my $result; + my $command_formatter = sub { + my ($out_mode, $out) = @_; + return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out; + }; + if ($self->{OUT}) { - open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!"); } else { - open(OUT, ">-") or $self->error("STDOUT : $!"); + *OUT = ($::dispatcher->get_standard_filehandles)[1]; $self->header; } @@ -794,64 +1118,71 @@ sub parse_template { $self->error("$self->{IN} : " . $template->get_error()); } - close(OUT); + close OUT if $self->{OUT}; + + if ($self->{media} eq 'file') { + copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file; + $self->cleanup; + chdir("$self->{cwd}"); + + $::lxdebug->leave_sub(); + + return; + } if ($template->uses_temp_file() || $self->{media} eq 'email') { if ($self->{media} eq 'email') { - use SL::Mailer; - my $mail = new Mailer; map { $mail->{$_} = $self->{$_} } - qw(cc bcc subject message version format charset); - $mail->{to} = qq|$self->{email}|; + qw(cc bcc subject message version format); + $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; + $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; - $mail->{fileid} = "$fileid."; - $myconfig->{signature} =~ s/\\r\\n/\\n/g; + $mail->{fileid} = time() . '.' . $$ . '.'; + $myconfig->{signature} =~ s/\r//g; # if we send html or plain text inline if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) { - $mail->{contenttype} = "text/html"; - - $mail->{message} =~ s/\r\n/
\n/g; - $myconfig->{signature} =~ s/\\n/
\n/g; - $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; + $mail->{contenttype} = "text/html"; + $mail->{message} =~ s/\r//g; + $mail->{message} =~ s/\n/
\n/g; + $myconfig->{signature} =~ s/\n/
\n/g; + $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; - open(IN, $self->{tmpfile}) + open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); - while () { - $mail->{message} .= $_; - } - + $mail->{message} .= $_ while ; close(IN); } else { if (!$self->{"do_not_attach"}) { - @{ $mail->{attachments} } = - ({ "filename" => $self->{"tmpfile"}, - "name" => $self->{"attachment_filename"} ? - $self->{"attachment_filename"} : $self->{"tmpfile"} }); + my $attachment_name = $self->{attachment_filename} || $self->{tmpfile}; + $attachment_name =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format); + $mail->{attachments} = [{ "filename" => $self->{tmpfile}, + "name" => $attachment_name }]; } - $mail->{message} =~ s/\r\n/\n/g; - $myconfig->{signature} =~ s/\\n/\n/g; - $mail->{message} .= "\n-- \n$myconfig->{signature}"; + $mail->{message} =~ s/\r//g; + $mail->{message} .= "\n-- \n$myconfig->{signature}"; } - my $err = $mail->send($out); + my $err = $mail->send(); $self->error($self->cleanup . "$err") if ($err); } else { - $self->{OUT} = $out; + $self->{OUT} = $out; + $self->{OUT_MODE} = $out_mode; my $numbytes = (-s $self->{tmpfile}); - open(IN, $self->{tmpfile}) + open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); + binmode IN; $self->{copies} = 1 unless $self->{media} eq 'printer'; @@ -860,10 +1191,18 @@ sub parse_template { #print(STDERR "OUT $self->{OUT}\n"); for my $i (1 .. $self->{copies}) { if ($self->{OUT}) { - open(OUT, $self->{OUT}) - or $self->error($self->cleanup . "$self->{OUT} : $!"); + $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT}); + + open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; + close OUT; + seek IN, 0, 0; + } else { - $self->{attachment_filename} = $self->{tmpfile} if ($self->{attachment_filename} eq ''); + $self->{attachment_filename} = ($self->{attachment_filename}) + ? $self->{attachment_filename} + : $self->generate_attachment_filename(); + # launch application print qq|Content-Type: | . $template->get_mime_type() . qq| Content-Disposition: attachment; filename="$self->{attachment_filename}" @@ -871,17 +1210,8 @@ Content-Length: $numbytes |; - open(OUT, ">-") or $self->error($self->cleanup . "$!: STDOUT"); - + $::locale->with_raw_io(\*STDOUT, sub { print while }); } - - while () { - print OUT $_; - } - - close(OUT); - - seek IN, 0, 0; } close(IN); @@ -895,21 +1225,126 @@ Content-Length: $numbytes $main::lxdebug->leave_sub(); } +sub get_formname_translation { + $main::lxdebug->enter_sub(); + my ($self, $formname) = @_; + + $formname ||= $self->{formname}; + + $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language}); + local $::locale = Locale->new($self->{recipient_locale}); + + my %formname_translations = ( + bin_list => $main::locale->text('Bin List'), + credit_note => $main::locale->text('Credit Note'), + invoice => $main::locale->text('Invoice'), + pick_list => $main::locale->text('Pick List'), + proforma => $main::locale->text('Proforma Invoice'), + purchase_order => $main::locale->text('Purchase Order'), + request_quotation => $main::locale->text('RFQ'), + sales_order => $main::locale->text('Confirmation'), + sales_quotation => $main::locale->text('Quotation'), + storno_invoice => $main::locale->text('Storno Invoice'), + sales_delivery_order => $main::locale->text('Delivery Order'), + purchase_delivery_order => $main::locale->text('Delivery Order'), + dunning => $main::locale->text('Dunning'), + ); + + $main::lxdebug->leave_sub(); + return $formname_translations{$formname}; +} + +sub get_number_prefix_for_type { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $prefix = + (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv' + : ($self->{type} =~ /_quotation$/) ? 'quo' + : ($self->{type} =~ /_delivery_order$/) ? 'do' + : 'ord'; + + $main::lxdebug->leave_sub(); + return $prefix; +} + +sub get_extension_for_format { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $extension = $self->{format} =~ /pdf/i ? ".pdf" + : $self->{format} =~ /postscript/i ? ".ps" + : $self->{format} =~ /opendocument/i ? ".odt" + : $self->{format} =~ /excel/i ? ".xls" + : $self->{format} =~ /html/i ? ".html" + : ""; + + $main::lxdebug->leave_sub(); + return $extension; +} + +sub generate_attachment_filename { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language}); + my $recipient_locale = Locale->new($self->{recipient_locale}); + + my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); + my $prefix = $self->get_number_prefix_for_type(); + + if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) { + $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format(); + + } elsif ($attachment_filename && $self->{"${prefix}number"}) { + $attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format(); + + } else { + $attachment_filename = ""; + } + + $attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename); + $attachment_filename =~ s|[\s/\\]+|_|g; + + $main::lxdebug->leave_sub(); + return $attachment_filename; +} + +sub generate_email_subject { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation()); + my $prefix = $self->get_number_prefix_for_type(); + + if ($subject && $self->{"${prefix}number"}) { + $subject .= " " . $self->{"${prefix}number"} + } + + $main::lxdebug->leave_sub(); + return $subject; +} + sub cleanup { $main::lxdebug->enter_sub(); - my $self = shift; + my ($self, $application) = @_; + + my $error_code = $?; chdir("$self->{tmpdir}"); my @err = (); - if (-f "$self->{tmpfile}.err") { + if ((-1 == $error_code) || (127 == (($error_code) >> 8))) { + push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.'); + + } elsif (-f "$self->{tmpfile}.err") { open(FH, "$self->{tmpfile}.err"); @err = ; close(FH); } - if ($self->{tmpfile}) { + if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) { $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; @@ -928,6 +1363,7 @@ sub datetonum { $main::lxdebug->enter_sub(); my ($self, $date, $myconfig) = @_; + my ($yy, $mm, $dd); if ($date && $date =~ /\D/) { @@ -959,15 +1395,21 @@ sub datetonum { # Database routines used throughout +sub _dbconnect_options { + my $self = shift; + my $options = { pg_enable_utf8 => $::locale->is_utf8, + @_ }; + + return $options; +} + sub dbconnect { $main::lxdebug->enter_sub(2); my ($self, $myconfig) = @_; # connect to database - my $dbh = - DBI->connect($myconfig->{dbconnect}, - $myconfig->{dbuser}, $myconfig->{dbpasswd}) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options) or $self->dberror; # set db options @@ -986,9 +1428,7 @@ sub dbconnect_noauto { my ($self, $myconfig) = @_; # connect to database - $dbh = - DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, - $myconfig->{dbpasswd}, { AutoCommit => 0 }) + my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0)) or $self->dberror; # set db options @@ -1001,19 +1441,67 @@ sub dbconnect_noauto { return $dbh; } +sub get_standard_dbh { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $myconfig = shift || \%::myconfig; + + if ($standard_dbh && !$standard_dbh->{Active}) { + $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); + undef $standard_dbh; + } + + $standard_dbh ||= $self->dbconnect_noauto($myconfig); + + $main::lxdebug->leave_sub(2); + + return $standard_dbh; +} + +sub date_closed { + $main::lxdebug->enter_sub(); + + my ($self, $date, $myconfig) = @_; + my $dbh = $self->dbconnect($myconfig); + + my $query = "SELECT 1 FROM defaults WHERE ? < closedto"; + my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date)); + + # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke, + # es ist sicher ein conv_date vorher IMMER auszuführen. + # Testfälle ohne definiertes closedto: + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Zahlungsbuchung über Rechnungsmaske i.O. + # SELECT 1 FROM defaults WHERE '10.05.2011' < closedto + # Testfälle mit definiertem closedto (30.04.2011): + # Leere Datumseingabe i.O. + # SELECT 1 FROM defaults WHERE '' < closedto + # normale Buchung im geschloßenem Zeitraum i.O. + # SELECT 1 FROM defaults WHERE '21.04.2011' < closedto + # Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden! + # normale Buchung in aktiver Buchungsperiode i.O. + # SELECT 1 FROM defaults WHERE '01.05.2011' < closedto + + my ($closed) = $sth->fetchrow_array; + + $main::lxdebug->leave_sub(); + + return $closed; +} + sub update_balance { $main::lxdebug->enter_sub(); - my ($self, $dbh, $table, $field, $where, $value) = @_; + my ($self, $dbh, $table, $field, $where, $value, @values) = @_; # if we have a value, go do it if ($value != 0) { # retrieve balance from table my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; - my $sth = $dbh->prepare($query); - - $sth->execute || $self->dberror($query); + my $sth = prepare_execute_query($self, $dbh, $query, @values); my ($balance) = $sth->fetchrow_array; $sth->finish; @@ -1021,7 +1509,7 @@ sub update_balance { # update balance $query = "UPDATE $table SET $field = $balance WHERE $where"; - $dbh->do($query) || $self->dberror($query); + do_query($self, $dbh, $query, @values); } $main::lxdebug->leave_sub(); } @@ -1030,19 +1518,37 @@ sub update_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; - + my ($query); # some sanity check for currency if ($curr eq '') { $main::lxdebug->leave_sub(); return; } + $query = qq|SELECT curr FROM defaults|; - my $query = qq|SELECT e.curr FROM exchangerate e - WHERE e.curr = '$curr' - AND e.transdate = '$transdate' - FOR UPDATE|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + my ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; + + + if ($curr eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return; + } + + $query = qq|SELECT e.curr FROM exchangerate e + WHERE e.curr = ? AND e.transdate = ? + FOR UPDATE|; + my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); + + if ($buy == 0) { + $buy = ""; + } + if ($sell == 0) { + $sell = ""; + } + + $buy = conv_i($buy, "NULL"); + $sell = conv_i($sell, "NULL"); my $set; if ($buy != 0 && $sell != 0) { @@ -1056,14 +1562,15 @@ sub update_exchangerate { if ($sth->fetchrow_array) { $query = qq|UPDATE exchangerate SET $set - WHERE curr = '$curr' - AND transdate = '$transdate'|; + WHERE curr = ? + AND transdate = ?|; + } else { $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) - VALUES ('$curr', $buy, $sell, '$transdate')|; + VALUES (?, $buy, $sell, ?)|; } $sth->finish; - $dbh->do($query) || $self->dberror($query); + do_query($self, $dbh, $query, $curr, $transdate); $main::lxdebug->leave_sub(); } @@ -1075,12 +1582,15 @@ sub save_exchangerate { my $dbh = $self->dbconnect($myconfig); - my ($buy, $sell) = (0, 0); + my ($buy, $sell); + $buy = $rate if $fld eq 'buy'; $sell = $rate if $fld eq 'sell'; + $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -1090,120 +1600,32 @@ sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ($query); unless ($transdate) { $main::lxdebug->leave_sub(); return 1; } - my $query = qq|SELECT e.$fld FROM exchangerate e - WHERE e.curr = '$curr' - AND e.transdate = '$transdate'|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $query = qq|SELECT curr FROM defaults|; - my ($exchangerate) = $sth->fetchrow_array; - $sth->finish; + my ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; - if (!$exchangerate) { - $exchangerate = 1; + if ($currency eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return 1; } - $main::lxdebug->leave_sub(); - - return $exchangerate; -} - -sub set_payment_options { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $transdate) = @_; - - if ($self->{payment_id}) { - - my $dbh = $self->dbconnect($myconfig); - - my $query = - qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, | . - qq|p.description_long | . - qq|FROM payment_terms p | . - qq|WHERE p.id = ?|; - - ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, - $self->{payment_terms}) = - selectrow_query($self, $dbh, $query, $self->{payment_id}); - - if ($transdate eq "") { - if ($self->{invdate}) { - $transdate = $self->{invdate}; - } else { - $transdate = $self->{transdate}; - } - } - - $query = - qq|SELECT date '$transdate' + $self->{terms_netto} AS netto_date, | . - qq|date '$transdate' + $self->{terms_skonto} AS skonto_date | . - qq|FROM payment_terms LIMIT 1|; - ($self->{netto_date}, $self->{skonto_date}) = - selectrow_query($self, $dbh, $query); - - my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal}; - my $skonto_amount = $self->parse_amount($myconfig, $total) * - $self->{percent_skonto}; - - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); - - if ($self->{"language_id"}) { - $query = - qq|SELECT t.description_long, | . - qq|l.output_numberformat, l.output_dateformat, l.output_longdates | . - qq|FROM translation_payment_terms t | . - qq|LEFT JOIN language l ON t.language_id = l.id | . - qq|WHERE (t.language_id = ?) AND (t.payment_terms_id = ?)|; - my ($description_long, $output_numberformat, $output_dateformat, - $output_longdates) = - selectrow_query($self, $dbh, $query, - $self->{"language_id"}, $self->{"payment_id"}); - - $self->{payment_terms} = $description_long if ($description_long); - - if ($output_dateformat) { - foreach my $key (qw(netto_date skonto_date)) { - $self->{$key} = - $main::locale->reformat_date($myconfig, $self->{$key}, - $output_dateformat, - $output_longdates); - } - } - - if ($output_numberformat && - ($output_numberformat ne $myconfig->{"numberformat"})) { - my $saved_numberformat = $myconfig->{"numberformat"}; - $myconfig->{"numberformat"} = $output_numberformat; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); - $myconfig->{"numberformat"} = $saved_numberformat; - } - } + $query = qq|SELECT e.$fld FROM exchangerate e + WHERE e.curr = ? AND e.transdate = ?|; + my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); - $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; - $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; - $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g; - $self->{payment_terms} =~ s/<%total%>/$self->{total}/g; - $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g; - $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; - $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g; - $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; - $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; - $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; - $dbh->disconnect; - } $main::lxdebug->leave_sub(); + return $exchangerate; } sub check_exchangerate { @@ -1211,172 +1633,284 @@ sub check_exchangerate { my ($self, $myconfig, $currency, $transdate, $fld) = @_; + if ($fld !~/^buy|sell$/) { + $self->error('Fatal: check_exchangerate called with invalid buy/sell argument'); + } + unless ($transdate) { $main::lxdebug->leave_sub(); return ""; } - my $dbh = $self->dbconnect($myconfig); + my ($defaultcurrency) = $self->get_default_currency($myconfig); + + if ($currency eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return 1; + } + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT e.$fld FROM exchangerate e - WHERE e.curr = '$currency' - AND e.transdate = '$transdate'|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + WHERE e.curr = ? AND e.transdate = ?|; - my ($exchangerate) = $sth->fetchrow_array; - $sth->finish; - $dbh->disconnect; + my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); $main::lxdebug->leave_sub(); return $exchangerate; } -sub get_template_language { +sub get_all_currencies { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; + my $self = shift; + my $myconfig = shift || \%::myconfig; + my $dbh = $self->get_standard_dbh($myconfig); - my $template_code = ""; + my $query = qq|SELECT curr FROM defaults|; - if ($self->{language_id}) { + my ($curr) = selectrow_query($self, $dbh, $query); + my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr; + + $main::lxdebug->leave_sub(); - my $dbh = $self->dbconnect($myconfig); + return @currencies; +} +sub get_default_currency { + $main::lxdebug->enter_sub(); - my $query = qq|SELECT l.template_code FROM language l - WHERE l.id = $self->{language_id}|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - ($template_code) = $sth->fetchrow_array; - $sth->finish; - $dbh->disconnect; - } + my ($self, $myconfig) = @_; + my @currencies = $self->get_all_currencies($myconfig); $main::lxdebug->leave_sub(); - return $template_code; + return $currencies[0]; } -sub get_printer_code { +sub set_payment_options { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; + my ($self, $myconfig, $transdate) = @_; - my $template_code = ""; + return $main::lxdebug->leave_sub() unless ($self->{payment_id}); - if ($self->{printer_id}) { + my $dbh = $self->get_standard_dbh($myconfig); - my $dbh = $self->dbconnect($myconfig); + my $query = + qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | . + qq|FROM payment_terms p | . + qq|WHERE p.id = ?|; + ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, + $self->{payment_terms}, $self->{payment_description}) = + selectrow_query($self, $dbh, $query, $self->{payment_id}); - my $query = qq|SELECT p.template_code,p.printer_command FROM printers p - WHERE p.id = $self->{printer_id}|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - ($template_code, $self->{printer_command}) = $sth->fetchrow_array; - $sth->finish; - $dbh->disconnect; + if ($transdate eq "") { + if ($self->{invdate}) { + $transdate = $self->{invdate}; + } else { + $transdate = $self->{transdate}; + } } - $main::lxdebug->leave_sub(); + $query = + qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | . + qq|FROM payment_terms|; + ($self->{netto_date}, $self->{skonto_date}) = + selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto}); - return $template_code; -} + my ($invtotal, $total); + my (%amounts, %formatted_amounts); -sub get_shipto { - $main::lxdebug->enter_sub(); + if ($self->{type} =~ /_order$/) { + $amounts{invtotal} = $self->{ordtotal}; + $amounts{total} = $self->{ordtotal}; - my ($self, $myconfig) = @_; + } elsif ($self->{type} =~ /_quotation$/) { + $amounts{invtotal} = $self->{quototal}; + $amounts{total} = $self->{quototal}; - my $template_code = ""; + } else { + $amounts{invtotal} = $self->{invtotal}; + $amounts{total} = $self->{total}; + } + $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto}; - if ($self->{shipto_id}) { + map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts; - my $dbh = $self->dbconnect($myconfig); + $amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto}; + $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto}); + $amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto}); + foreach (keys %amounts) { + $amounts{$_} = $self->round_amount($amounts{$_}, 2); + $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2); + } - my $query = qq|SELECT s.* FROM shipto s - WHERE s.shipto_id = $self->{shipto_id}|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - map { $self->{$_} = $ref->{$_} } keys %$ref; - $sth->finish; - $dbh->disconnect; + if ($self->{"language_id"}) { + $query = + qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | . + qq|FROM generic_translations t | . + qq|LEFT JOIN language l ON t.language_id = l.id | . + qq|WHERE (t.language_id = ?) + AND (t.translation_id = ?) + AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|; + my ($description_long, $output_numberformat, $output_dateformat, + $output_longdates) = + selectrow_query($self, $dbh, $query, + $self->{"language_id"}, $self->{"payment_id"}); + + $self->{payment_terms} = $description_long if ($description_long); + + if ($output_dateformat) { + foreach my $key (qw(netto_date skonto_date)) { + $self->{$key} = + $main::locale->reformat_date($myconfig, $self->{$key}, + $output_dateformat, + $output_longdates); + } + } + + if ($output_numberformat && + ($output_numberformat ne $myconfig->{"numberformat"})) { + my $saved_numberformat = $myconfig->{"numberformat"}; + $myconfig->{"numberformat"} = $output_numberformat; + map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts; + $myconfig->{"numberformat"} = $saved_numberformat; + } } + $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; + $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; + $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; + $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g; + $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; + $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; + $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; + + map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts; + + $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent}; + $main::lxdebug->leave_sub(); } +sub get_template_language { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + + my $template_code = ""; + + if ($self->{language_id}) { + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT template_code FROM language WHERE id = ?|; + ($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id}); + } + + $main::lxdebug->leave_sub(); + + return $template_code; +} + +sub get_printer_code { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + + my $template_code = ""; + + if ($self->{printer_id}) { + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|; + ($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id}); + } + + $main::lxdebug->leave_sub(); + + return $template_code; +} + +sub get_shipto { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + + my $template_code = ""; + + if ($self->{shipto_id}) { + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|; + my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id}); + map({ $self->{$_} = $ref->{$_} } keys(%$ref)); + } + + $main::lxdebug->leave_sub(); +} + sub add_shipto { $main::lxdebug->enter_sub(); my ($self, $dbh, $id, $module) = @_; -##LINET + my $shipto; - foreach my $item ( - qw(name department_1 department_2 street zipcode city country contact phone fax email) - ) { + my @values; + + foreach my $item (qw(name department_1 department_2 street zipcode city country + contact cp_gender phone fax email)) { if ($self->{"shipto$item"}) { $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"}); } - $self->{"shipto$item"} =~ s/\'/\'\'/g; + push(@values, $self->{"shipto${item}"}); } + if ($shipto) { if ($self->{shipto_id}) { - my $query = qq| UPDATE shipto set - shiptoname = '$self->{shiptoname}', - shiptodepartment_1 = '$self->{shiptodepartment_1}', - shiptodepartment_2 = '$self->{shiptodepartment_2}', - shiptostreet = '$self->{shiptostreet}', - shiptozipcode = '$self->{shiptozipcode}', - shiptocity = '$self->{shiptocity}', - shiptocountry = '$self->{shiptocountry}', - shiptocontact = '$self->{shiptocontact}', - shiptophone = '$self->{shiptophone}', - shiptofax = '$self->{shiptofax}', - shiptoemail = '$self->{shiptoemail}' - WHERE shipto_id = $self->{shipto_id}|; - $dbh->do($query) || $self->dberror($query); + my $query = qq|UPDATE shipto set + shiptoname = ?, + shiptodepartment_1 = ?, + shiptodepartment_2 = ?, + shiptostreet = ?, + shiptozipcode = ?, + shiptocity = ?, + shiptocountry = ?, + shiptocontact = ?, + shiptocp_gender = ?, + shiptophone = ?, + shiptofax = ?, + shiptoemail = ? + WHERE shipto_id = ?|; + do_query($self, $dbh, $query, @values, $self->{shipto_id}); } else { my $query = qq|SELECT * FROM shipto - WHERE shiptoname = '$self->{shiptoname}' AND - shiptodepartment_1 = '$self->{shiptodepartment_1}' AND - shiptodepartment_2 = '$self->{shiptodepartment_2}' AND - shiptostreet = '$self->{shiptostreet}' AND - shiptozipcode = '$self->{shiptozipcode}' AND - shiptocity = '$self->{shiptocity}' AND - shiptocountry = '$self->{shiptocountry}' AND - shiptocontact = '$self->{shiptocontact}' AND - shiptophone = '$self->{shiptophone}' AND - shiptofax = '$self->{shiptofax}' AND - shiptoemail = '$self->{shiptoemail}' - | ; - my $sth = $dbh->prepare($query); - $sth->execute() || $self->dberror($query); - my $insert_check = $sth->fetch(); - $sth->finish(); + WHERE shiptoname = ? AND + shiptodepartment_1 = ? AND + shiptodepartment_2 = ? AND + shiptostreet = ? AND + shiptozipcode = ? AND + shiptocity = ? AND + shiptocountry = ? AND + shiptocontact = ? AND + shiptocp_gender = ? AND + shiptophone = ? AND + shiptofax = ? AND + shiptoemail = ? AND + module = ? AND + trans_id = ?|; + my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); if(!$insert_check){ $query = - qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, - shiptodepartment_2, shiptostreet, - shiptozipcode, shiptocity, shiptocountry, shiptocontact, - shiptophone, shiptofax, shiptoemail, module) VALUES ($id, - '$self->{shiptoname}', '$self->{shiptodepartment_1}', '$self->{shiptodepartment_2}', '$self->{shiptostreet}', - '$self->{shiptozipcode}', '$self->{shiptocity}', - '$self->{shiptocountry}', '$self->{shiptocontact}', - '$self->{shiptophone}', '$self->{shiptofax}', - '$self->{shiptoemail}', '$module')|; - $dbh->do($query) || $self->dberror($query); - } + qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, + shiptostreet, shiptozipcode, shiptocity, shiptocountry, + shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module) + VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $id, @values, $module); + } } } -##/LINET + $main::lxdebug->leave_sub(); } @@ -1385,95 +1919,91 @@ sub get_employee { my ($self, $dbh) = @_; - my $query = qq|SELECT e.id, e.name FROM employee e - WHERE e.login = '$self->{login}'|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - ($self->{employee_id}, $self->{employee}) = $sth->fetchrow_array; - $self->{employee_id} *= 1; + $dbh ||= $self->get_standard_dbh(\%main::myconfig); - $sth->finish; + my $query = qq|SELECT id, name FROM employee WHERE login = ?|; + ($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login}); + $self->{"employee_id"} *= 1; $main::lxdebug->leave_sub(); } -sub get_salesman { +sub get_employee_data { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $salesman_id) = @_; + my $self = shift; + my %params = @_; - $main::lxdebug->leave_sub() and return unless $salesman_id; + Common::check_params(\%params, qw(prefix)); + Common::check_params_x(\%params, qw(id)); - my $dbh = $self->dbconnect($myconfig); + if (!$params{id}) { + $main::lxdebug->leave_sub(); + return; + } - my ($login) = - selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, - $salesman_id); + my $myconfig = \%main::myconfig; + my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig); - if ($login) { - my $user = new User($main::memberfile, $login); - map({ $self->{"salesman_$_"} = $user->{$_}; } - qw(address businessnumber co_ustid company duns email fax name - taxnumber tel)); - $self->{salesman_login} = $login; + my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id})); - $self->{salesman_name} = $login - if ($self->{salesman_name} eq ""); + if ($login) { + my $user = User->new(login => $login); + map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel); - map({ $self->{"salesman_$_"} =~ s/\\n/\n/g; } qw(address company)); + $self->{$params{prefix} . '_login'} = $login; + $self->{$params{prefix} . '_name'} ||= $login; } - $dbh->disconnect(); - $main::lxdebug->leave_sub(); } sub get_duedate { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; + my ($self, $myconfig, $reference_date) = @_; - my $dbh = $self->dbconnect($myconfig); - my $query = qq|SELECT current_date+terms_netto FROM payment_terms - WHERE id = '$self->{payment_id}'|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date'; - ($self->{duedate}) = $sth->fetchrow_array; + my $dbh = $self->get_standard_dbh($myconfig); + my $payment_id; - $sth->finish; + if($self->{payment_id}) { + $payment_id = $self->{payment_id}; + } elsif($self->{vendor_id}) { + my $query = 'SELECT payment_id FROM vendor WHERE id = ?'; + ($payment_id) = selectrow_query($self, $dbh, $query, $self->{vendor_id}); + } + + my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|; + my ($duedate) = selectrow_query($self, $dbh, $query, $payment_id); $main::lxdebug->leave_sub(); + + return $duedate; } -# get contacts for id, if no contact return {"","","","",""} sub _get_contacts { $main::lxdebug->enter_sub(); my ($self, $dbh, $id, $key) = @_; $key = "all_contacts" unless ($key); - $self->{$key} = []; + + if (!$id) { + $self->{$key} = []; + $main::lxdebug->leave_sub(); + return; + } my $query = - qq|SELECT c.cp_id, c.cp_cv_id, c.cp_name, c.cp_givenname, c.cp_abteilung | . - qq|FROM contacts c | . + qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | . + qq|FROM contacts | . qq|WHERE cp_cv_id = ? | . - qq|ORDER BY lower(c.cp_name)|; - my $sth = $dbh->prepare($query); - $sth->execute($id) || $self->dberror($query . " ($id)"); + qq|ORDER BY lower(cp_name)|; - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{$key} }, $ref; - $i++; - } + $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id); - if ($i == 0) { - push @{ $self->{$key} }, { { "", "", "", "", "", "" } }; - } - $sth->finish; $main::lxdebug->leave_sub(); } @@ -1521,16 +2051,9 @@ sub _get_projects { qq|FROM project | . $where . qq|ORDER BY lower(projectnumber)|; - my $sth = $dbh->prepare($query); - $sth->execute(@values) || - $self->dberror($query . " (" . join(", ", @values) . ")"); - $self->{$key} = []; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{$key} }, $ref); - } + $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values); - $sth->finish; $main::lxdebug->leave_sub(); } @@ -1540,20 +2063,16 @@ sub _get_shipto { my ($self, $dbh, $vc_id, $key) = @_; $key = "all_shipto" unless ($key); - $self->{$key} = []; - # get shipping addresses - my $query = - qq|SELECT s.shipto_id,s.shiptoname,s.shiptodepartment_1 | . - qq|FROM shipto s | . - qq|WHERE s.trans_id = ?|; - my $sth = $dbh->prepare($query); - $sth->execute($vc_id) || $self->dberror($query . " ($vc_id)"); + if ($vc_id) { + # get shipping addresses + my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{$key} }, $ref); + } else { + $self->{$key} = []; } - $sth->finish; $main::lxdebug->leave_sub(); } @@ -1564,16 +2083,10 @@ sub _get_printers { my ($self, $dbh, $key) = @_; $key = "all_printers" unless ($key); - $self->{$key} = []; - my $query = qq|SELECT id, printer_description, printer_command FROM printers|; - my $sth = $dbh->prepare($query); - $sth->execute() || $self->dberror($query); + my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{$key} }, $ref); - } - $sth->finish; + $self->{$key} = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); } @@ -1582,15 +2095,15 @@ sub _get_charts { $main::lxdebug->enter_sub(); my ($self, $dbh, $params) = @_; + my ($key); $key = $params->{key}; $key = "all_charts" unless ($key); - $self->{$key} = []; my $transdate = quote_db_date($params->{transdate}); my $query = - qq|SELECT c.accno, c.description, c.link, tk.taxkey_id, tk.tax_id | . + qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | . qq|FROM chart c | . qq|LEFT JOIN taxkeys tk ON | . qq|(tk.id = (SELECT id FROM taxkeys | . @@ -1598,69 +2111,263 @@ sub _get_charts { qq| ORDER BY startdate DESC LIMIT 1)) | . qq|ORDER BY c.accno|; - my $sth = $dbh->prepare($query); - $sth->execute() || $self->dberror($query); + $self->{$key} = selectall_hashref_query($self, $dbh, $query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{$key} }, $ref); + $main::lxdebug->leave_sub(); +} + +sub _get_taxcharts { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $params) = @_; + + my $key = "all_taxcharts"; + my @where; + + if (ref $params eq 'HASH') { + $key = $params->{key} if ($params->{key}); + if ($params->{module} eq 'AR') { + push @where, 'taxkey NOT IN (8, 9, 18, 19)'; + + } elsif ($params->{module} eq 'AP') { + push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)'; + } + + } elsif ($params) { + $key = $params; } - $sth->finish; + + my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : ''; + + my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); } -sub _get_taxcharts { +sub _get_taxzones { $main::lxdebug->enter_sub(); my ($self, $dbh, $key) = @_; - $key = "all_taxcharts" unless ($key); - $self->{$key} = []; + $key = "all_taxzones" unless ($key); + + my $query = qq|SELECT * FROM tax_zones ORDER BY id|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_employees { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $default_key, $key) = @_; + + $key = $default_key unless ($key); + $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|); + + $main::lxdebug->leave_sub(); +} + +sub _get_business_types { + $main::lxdebug->enter_sub(); - my $query = qq|SELECT * FROM tax ORDER BY taxkey|; + my ($self, $dbh, $key) = @_; - my $sth = $dbh->prepare($query); - $sth->execute() || $self->dberror($query); + my $options = ref $key eq 'HASH' ? $key : { key => $key }; + $options->{key} ||= "all_business_types"; + my $where = ''; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{$key} }, $ref); + if (exists $options->{salesman}) { + $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)'; } - $sth->finish; + + $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|); $main::lxdebug->leave_sub(); } -sub _get_employees { +sub _get_languages { $main::lxdebug->enter_sub(); my ($self, $dbh, $key) = @_; - $key = "all_employees" unless ($key); - $self->{$key} = - selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee|); + $key = "all_languages" unless ($key); + + my $query = qq|SELECT * FROM language ORDER BY id|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); } -sub _get_business_types { +sub _get_dunning_configs { $main::lxdebug->enter_sub(); my ($self, $dbh, $key) = @_; - $key = "all_business_types" unless ($key); - $self->{$key} = - selectall_hashref_query($self, $dbh, qq|SELECT * FROM business|); + $key = "all_dunning_configs" unless ($key); + + my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_currencies { +$main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key = "all_currencies" unless ($key); + + my $query = qq|SELECT curr AS currency FROM defaults|; + + $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})]; + + $main::lxdebug->leave_sub(); +} + +sub _get_payments { +$main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key = "all_payments" unless ($key); + + my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_customers { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + my $options = ref $key eq 'HASH' ? $key : { key => $key }; + $options->{key} ||= "all_customers"; + my $limit_clause = $options->{limit} ? "LIMIT $options->{limit}" : ''; + + my @where; + push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman}; + push @where, qq|NOT obsolete| if !$options->{with_obsolete}; + my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : ''; + + my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|; + $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_vendors { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key = "all_vendors" unless ($key); + + my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_departments { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key = "all_departments" unless ($key); + + my $query = qq|SELECT * FROM department ORDER BY description|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_warehouses { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $param) = @_; + + my ($key, $bins_key); + + if ('' eq ref $param) { + $key = $param; + + } else { + $key = $param->{key}; + $bins_key = $param->{bins}; + } + + my $query = qq|SELECT w.* FROM warehouse w + WHERE (NOT w.invalid) AND + ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0) + ORDER BY w.sortkey|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + if ($bins_key) { + $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ? + ORDER BY description|; + my $sth = prepare_query($self, $dbh, $query); + + foreach my $warehouse (@{ $self->{$key} }) { + do_statement($self, $sth, $query, $warehouse->{id}); + $warehouse->{$bins_key} = []; + + while (my $ref = $sth->fetchrow_hashref()) { + push @{ $warehouse->{$bins_key} }, $ref; + } + } + $sth->finish(); + } + + $main::lxdebug->leave_sub(); +} + +sub _get_simple { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $table, $key, $sortkey) = @_; + + my $query = qq|SELECT * FROM $table|; + $query .= qq| ORDER BY $sortkey| if ($sortkey); + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); } +#sub _get_groups { +# $main::lxdebug->enter_sub(); +# +# my ($self, $dbh, $key) = @_; +# +# $key ||= "all_groups"; +# +# my $groups = $main::auth->read_groups(); +# +# $self->{$key} = selectall_hashref_query($self, $dbh, $query); +# +# $main::lxdebug->leave_sub(); +#} + sub get_lists { $main::lxdebug->enter_sub(); my $self = shift; my %params = @_; - my $dbh = $self->dbconnect(\%main::myconfig); + my $dbh = $self->get_standard_dbh(\%main::myconfig); my ($sth, $query, $ref); my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor"; @@ -1684,6 +2391,10 @@ sub get_lists { $self->_get_printers($dbh, $params{"printers"}); } + if ($params{"languages"}) { + $self->_get_languages($dbh, $params{"languages"}); + } + if ($params{"charts"}) { $self->_get_charts($dbh, $params{"charts"}); } @@ -1692,15 +2403,65 @@ sub get_lists { $self->_get_taxcharts($dbh, $params{"taxcharts"}); } + if ($params{"taxzones"}) { + $self->_get_taxzones($dbh, $params{"taxzones"}); + } + if ($params{"employees"}) { - $self->_get_employees($dbh, $params{"employees"}); + $self->_get_employees($dbh, "all_employees", $params{"employees"}); + } + + if ($params{"salesmen"}) { + $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"}); } if ($params{"business_types"}) { $self->_get_business_types($dbh, $params{"business_types"}); } - $dbh->disconnect(); + if ($params{"dunning_configs"}) { + $self->_get_dunning_configs($dbh, $params{"dunning_configs"}); + } + + if($params{"currencies"}) { + $self->_get_currencies($dbh, $params{"currencies"}); + } + + if($params{"customers"}) { + $self->_get_customers($dbh, $params{"customers"}); + } + + if($params{"vendors"}) { + if (ref $params{"vendors"} eq 'HASH') { + $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit}); + } else { + $self->_get_vendors($dbh, $params{"vendors"}); + } + } + + if($params{"payments"}) { + $self->_get_payments($dbh, $params{"payments"}); + } + + if($params{"departments"}) { + $self->_get_departments($dbh, $params{"departments"}); + } + + if ($params{price_factors}) { + $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey'); + } + + if ($params{warehouses}) { + $self->_get_warehouses($dbh, $params{warehouses}); + } + +# if ($params{groups}) { +# $self->_get_groups($dbh, $params{groups}); +# } + + if ($params{partsgroup}) { + $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} }); + } $main::lxdebug->leave_sub(); } @@ -1712,52 +2473,48 @@ sub get_name { my ($self, $myconfig, $table) = @_; # connect to database - my $dbh = $self->dbconnect($myconfig); - - my $name = $self->like(lc $self->{$table}); - my $customernumber = $self->like(lc $self->{customernumber}); + my $dbh = $self->get_standard_dbh($myconfig); - if ($self->{customernumber} ne "") { - $query = qq~SELECT c.id, c.name, - c.street || ' ' || c.zipcode || ' ' || c.city || ' ' || c.country AS address - FROM $table c - WHERE (lower(c.customernumber) LIKE '$customernumber') AND (not c.obsolete) - ORDER BY c.name~; - } else { - $query = qq~SELECT c.id, c.name, - c.street || ' ' || c.zipcode || ' ' || c.city || ' ' || c.country AS address - FROM $table c - WHERE (lower(c.name) LIKE '$name') AND (not c.obsolete) - ORDER BY c.name~; - } + $table = $table eq "customer" ? "customer" : "vendor"; + my $arap = $self->{arap} eq "ar" ? "ar" : "ap"; - if ($self->{openinvoices}) { - $query = qq~SELECT DISTINCT c.id, c.name, - c.street || ' ' || c.zipcode || ' ' || c.city || ' ' || c.country AS address - FROM $self->{arap} a - JOIN $table c ON (a.${table}_id = c.id) - WHERE NOT a.amount = a.paid - AND lower(c.name) LIKE '$name' - ORDER BY c.name~; - } - my $sth = $dbh->prepare($query); + my ($query, @values); - $sth->execute || $self->dberror($query); + if (!$self->{openinvoices}) { + my $where; + if ($self->{customernumber} ne "") { + $where = qq|(vc.customernumber ILIKE ?)|; + push(@values, '%' . $self->{customernumber} . '%'); + } else { + $where = qq|(vc.name ILIKE ?)|; + push(@values, '%' . $self->{$table} . '%'); + } - my $i = 0; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{name_list} }, $ref); - $i++; + $query = + qq~SELECT vc.id, vc.name, + vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address + FROM $table vc + WHERE $where AND (NOT vc.obsolete) + ORDER BY vc.name~; + } else { + $query = + qq~SELECT DISTINCT vc.id, vc.name, + vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address + FROM $arap a + JOIN $table vc ON (a.${table}_id = vc.id) + WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?) + ORDER BY vc.name~; + push(@values, '%' . $self->{$table} . '%'); } - $sth->finish; - $dbh->disconnect; + + $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values); $main::lxdebug->leave_sub(); - return $i; + return scalar(@{ $self->{name_list} }); } -# the selection sub is used in the AR, AP, IS, IR and OE module +# the selection sub is used in the AR, AP, IS, IR, DO and OE module # sub all_vc { $main::lxdebug->enter_sub(); @@ -1765,28 +2522,23 @@ sub all_vc { my ($self, $myconfig, $table, $module) = @_; my $ref; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->get_standard_dbh; - my $query = qq|SELECT count(*) FROM $table|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - my ($count) = $sth->fetchrow_array; - $sth->finish; + $table = $table eq "customer" ? "customer" : "vendor"; # build selection list + # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege + # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch + # nicht für veränderbare Belege (oe, do, ...) + my $obsolete = "WHERE NOT obsolete" unless $self->{id}; + my $query = qq|SELECT count(*) FROM $table $obsolete|; + my ($count) = selectrow_query($self, $dbh, $query); + if ($count < $myconfig->{vclimit}) { $query = qq|SELECT id, name, salesman_id - FROM $table WHERE not obsolete - ORDER BY name|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{"all_$table"} }, $ref; - } - - $sth->finish; - + FROM $table $obsolete + ORDER BY name|; + $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query); } # get self @@ -1794,85 +2546,44 @@ sub all_vc { # setup sales contacts $query = qq|SELECT e.id, e.name - FROM employee e - WHERE e.sales = '1' - AND NOT e.id = $self->{employee_id}|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_employees} }, $ref; - } - $sth->finish; + FROM employee e + WHERE (e.sales = '1') AND (NOT e.id = ?) + ORDER BY name|; + $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id}); # this is for self - push @{ $self->{all_employees} }, - { id => $self->{employee_id}, - name => $self->{employee} }; - - # sort the whole thing - @{ $self->{all_employees} } = - sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} }; - - if ($module eq 'AR') { + push(@{ $self->{all_employees} }, + { id => $self->{employee_id}, + name => $self->{employee} }); # prepare query for departments - $query = qq|SELECT d.id, d.description - FROM department d - WHERE d.role = 'P' - ORDER BY 2|; - - } else { - $query = qq|SELECT d.id, d.description - FROM department d - ORDER BY 2|; - } + $query = qq|SELECT id, description + FROM department + ORDER BY description|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_departments} }, $ref; - } - $sth->finish; + $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); # get languages $query = qq|SELECT id, description FROM language - ORDER BY 1|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + ORDER BY id|; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{languages} }, $ref; - } - $sth->finish; + $self->{languages} = selectall_hashref_query($self, $dbh, $query); # get printer $query = qq|SELECT printer_description, id FROM printers - ORDER BY 1|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{printers} }, $ref; - } - $sth->finish; + ORDER BY printer_description|; + $self->{printers} = selectall_hashref_query($self, $dbh, $query); # get payment terms $query = qq|SELECT id, description FROM payment_terms ORDER BY sortkey|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{payment_terms} }, $ref; - } - $sth->finish; - $dbh->disconnect; + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + $main::lxdebug->leave_sub(); } @@ -1880,61 +2591,35 @@ sub language_payment { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; - undef $self->{languages}; - undef $self->{payment_terms}; - undef $self->{printers}; - my $ref; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->get_standard_dbh($myconfig); # get languages my $query = qq|SELECT id, description - FROM language - ORDER BY 1|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + FROM language + ORDER BY id|; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{languages} }, $ref; - } - $sth->finish; + $self->{languages} = selectall_hashref_query($self, $dbh, $query); # get printer $query = qq|SELECT printer_description, id FROM printers - ORDER BY 1|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + ORDER BY printer_description|; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{printers} }, $ref; - } - $sth->finish; + $self->{printers} = selectall_hashref_query($self, $dbh, $query); # get payment terms $query = qq|SELECT id, description FROM payment_terms ORDER BY sortkey|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{payment_terms} }, $ref; - } - $sth->finish; + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); # get buchungsgruppen $query = qq|SELECT id, description FROM buchungsgruppen|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - $self->{BUCHUNGSGRUPPEN} = []; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{BUCHUNGSGRUPPEN} }, $ref; - } - $sth->finish; + $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query); - $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -1944,28 +2629,14 @@ sub all_departments { my ($self, $myconfig, $table) = @_; - my $dbh = $self->dbconnect($myconfig); - my $where = "1 = 1"; - - if (defined $table) { - if ($table eq 'customer') { - $where = " d.role = 'P'"; - } - } - - my $query = qq|SELECT d.id, d.description - FROM department d - WHERE $where - ORDER BY 2|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + my $dbh = $self->get_standard_dbh($myconfig); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_departments} }, $ref; - } - $sth->finish; + my $query = qq|SELECT id, description + FROM department + ORDER BY description|; + $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); - $dbh->disconnect; + delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] }); $main::lxdebug->leave_sub(); } @@ -1973,49 +2644,76 @@ sub all_departments { sub create_links { $main::lxdebug->enter_sub(); - my ($self, $module, $myconfig, $table) = @_; + my ($self, $module, $myconfig, $table, $provided_dbh) = @_; + + my ($fld, $arap); + if ($table eq "customer") { + $fld = "buy"; + $arap = "ar"; + } else { + $table = "vendor"; + $fld = "sell"; + $arap = "ap"; + } $self->all_vc($myconfig, $table, $module); # get last customers or vendors - my ($query, $sth); + my ($query, $sth, $ref); - my $dbh = $self->dbconnect($myconfig); + my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig); my %xkeyref = (); if (!$self->{id}) { my $transdate = "current_date"; if ($self->{transdate}) { - $transdate = qq|'$self->{transdate}'|; + $transdate = $dbh->quote($self->{transdate}); } - + # now get the account numbers - $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id - FROM chart c, taxkeys tk - WHERE c.link LIKE '%$module%' AND c.id=tk.chart_id AND tk.id = - (SELECT id FROM taxkeys where taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate desc LIMIT 1) - ORDER BY c.accno|; - +# $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id +# FROM chart c, taxkeys tk +# WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id = +# (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1) +# ORDER BY c.accno|; + +# same query as above, but without expensive subquery for each row. about 80% faster + $query = qq| + SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id + FROM chart c + -- find newest entries in taxkeys + INNER JOIN ( + SELECT chart_id, MAX(startdate) AS startdate + FROM taxkeys + WHERE (startdate <= $transdate) + GROUP BY chart_id + ) tk ON (c.id = tk.chart_id) + -- and load all of those entries + INNER JOIN taxkeys tk2 + ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate) + WHERE (c.link LIKE ?) + ORDER BY c.accno|; + $sth = $dbh->prepare($query); - do_statement($form, $sth, $query); + do_statement($self, $sth, $query, '%' . $module . '%'); $self->{accounts} = ""; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { + foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { - + if ($key =~ /\Q$module\E/) { + # cross reference for keys $xkeyref{ $ref->{accno} } = $key; - + push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; - + $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; } } @@ -2024,88 +2722,71 @@ sub create_links { # get taxkeys and description $query = qq|SELECT id, taxkey, taxdescription FROM tax|; - $self->{TAXKEY} = selectall_hashref_query($form, $dbh, $query); - - # get tax zones - $query = qq|SELECT id, description FROM tax_zones|; - $self->{TAXZONE} = selectall_hashref_query($form, $dbh, $query); + $self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query); if (($module eq "AP") || ($module eq "AR")) { # get tax rates and description - $query = qq| SELECT * FROM tax t|; - $self->{TAX} = selectall_hashref_query($form, $dbh, $query); + $query = qq|SELECT * FROM tax|; + $self->{TAX} = selectall_hashref_query($self, $dbh, $query); } if ($self->{id}) { - my $arap = ($table eq 'customer') ? 'ar' : 'ap'; - - $query = qq|SELECT a.cp_id, a.invnumber, a.transdate, - a.${table}_id, a.datepaid, a.duedate, a.ordnumber, - a.taxincluded, a.curr AS currency, a.notes, a.intnotes, - c.name AS $table, a.department_id, d.description AS department, - a.amount AS oldinvtotal, a.paid AS oldtotalpaid, - a.employee_id, e.name AS employee, a.gldate, a.type - FROM $arap a - JOIN $table c ON (a.${table}_id = c.id) - LEFT JOIN employee e ON (e.id = a.employee_id) - LEFT JOIN department d ON (d.id = a.department_id) - WHERE a.id = $self->{id}|; - $sth = $dbh->prepare($query); - do_statement($form, $sth, $query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - foreach $key (keys %$ref) { + $query = + qq|SELECT + a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, + a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes, + a.intnotes, a.department_id, a.amount AS oldinvtotal, + a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type, + a.globalproject_id, + c.name AS $table, + d.description AS department, + e.name AS employee + FROM $arap a + JOIN $table c ON (a.${table}_id = c.id) + LEFT JOIN employee e ON (e.id = a.employee_id) + LEFT JOIN department d ON (d.id = a.department_id) + WHERE a.id = ?|; + $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id}); + + foreach my $key (keys %$ref) { $self->{$key} = $ref->{$key}; } - $sth->finish; + # remove any trailing whitespace + $self->{currency} =~ s/\s*$//; my $transdate = "current_date"; if ($self->{transdate}) { - $transdate = qq|'$self->{transdate}'|; + $transdate = $dbh->quote($self->{transdate}); } - + # now get the account numbers - $query = qq| - SELECT - c.accno, - c.description, - c.link, - c.taxkey_id, - tk.tax_id - FROM chart c - LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) - WHERE - c.link LIKE ? - AND - (tk.chart_id = c.id AND NOT c.link like '%_tax%') - OR (NOT tk.chart_id = c.id AND c.link like '%_tax%') - AND - tk.id = ( SELECT id from taxkeys - WHERE taxkeys.chart_id = c.id - AND startdate <= ? - ORDER BY startdate desc LIMIT 1 - ) - ORDER BY c.accno|; - + $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id + FROM chart c + LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) + WHERE c.link LIKE ? + AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1) + OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL) + ORDER BY c.accno|; + $sth = $dbh->prepare($query); - do_statement($form, $sth, $query, "%$module%", $transdate); - + do_statement($self, $sth, $query, "%$module%"); + $self->{accounts} = ""; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { + foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { - + if ($key =~ /\Q$module\E/) { + # cross reference for keys $xkeyref{ $ref->{accno} } = $key; - + push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, description => $ref->{description}, taxkey => $ref->{taxkey_id}, tax_id => $ref->{tax_id} }; - + $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; } } @@ -2113,31 +2794,38 @@ sub create_links { # get amounts from individual entries - $query = qq|SELECT c.accno, c.description, a.source, a.amount, a.memo, - a.transdate, a.cleared, a.project_id, p.projectnumber, a.taxkey, t.rate, t.id - FROM acc_trans a - JOIN chart c ON (c.id = a.chart_id) - LEFT JOIN project p ON (p.id = a.project_id) - LEFT JOIN tax t ON (t.id=(SELECT tk.tax_id from taxkeys tk WHERE (tk.taxkey_id=a.taxkey) AND ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id=a.taxkey) THEN tk.chart_id=a.chart_id ELSE 1=1 END) OR (c.link='%tax%')) AND startdate <=a.transdate ORDER BY startdate DESC LIMIT 1)) - WHERE a.trans_id = $self->{id} - AND a.fx_transaction = '0' - ORDER BY a.oid,a.transdate|; + $query = + qq|SELECT + c.accno, c.description, + a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, + p.projectnumber, + t.rate, t.id + FROM acc_trans a + LEFT JOIN chart c ON (c.id = a.chart_id) + LEFT JOIN project p ON (p.id = a.project_id) + LEFT JOIN tax t ON (t.id= (SELECT tk.tax_id FROM taxkeys tk + WHERE (tk.taxkey_id=a.taxkey) AND + ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id = a.taxkey) + THEN tk.chart_id = a.chart_id + ELSE 1 = 1 + END) + OR (c.link='%tax%')) AND + (startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1)) + WHERE a.trans_id = ? + AND a.fx_transaction = '0' + ORDER BY a.acc_trans_id, a.transdate|; $sth = $dbh->prepare($query); - do_statement($form, $sth, $query); - - my $fld = ($table eq 'customer') ? 'buy' : 'sell'; + do_statement($self, $sth, $query, $self->{id}); # get exchangerate for currency $self->{exchangerate} = - $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, - $fld); + $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld); my $index = 0; # store amounts in {acc_trans}{$key} for multiple accounts - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + while (my $ref = $sth->fetchrow_hashref("NAME_lc")) { $ref->{exchangerate} = - $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, - $fld); + $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld); if (!($xkeyref{ $ref->{accno} } =~ /tax/)) { $index++; } @@ -2150,60 +2838,44 @@ sub create_links { } $sth->finish; - $query = qq|SELECT d.curr AS currencies, d.closedto, d.revtrans, - (SELECT c.accno FROM chart c - WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, - (SELECT c.accno FROM chart c - WHERE d.fxloss_accno_id = c.id) AS fxloss_accno - FROM defaults d|; - $sth = $dbh->prepare($query); - do_statement($form, $sth, $query); - - $ref = $sth->fetchrow_hashref(NAME_lc); + $query = + qq|SELECT + d.curr AS currencies, d.closedto, d.revtrans, + (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + FROM defaults d|; + $ref = selectfirst_hashref_query($self, $dbh, $query); map { $self->{$_} = $ref->{$_} } keys %$ref; - $sth->finish; } else { # get date - $query = qq|SELECT current_date AS transdate, - d.curr AS currencies, d.closedto, d.revtrans, - (SELECT c.accno FROM chart c - WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, - (SELECT c.accno FROM chart c - WHERE d.fxloss_accno_id = c.id) AS fxloss_accno - FROM defaults d|; - $sth = $dbh->prepare($query); - do_statement($form, $sth, $query); - - $ref = $sth->fetchrow_hashref(NAME_lc); + $query = + qq|SELECT + current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans, + (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + FROM defaults d|; + $ref = selectfirst_hashref_query($self, $dbh, $query); map { $self->{$_} = $ref->{$_} } keys %$ref; - $sth->finish; if ($self->{"$self->{vc}_id"}) { # only setup currency - ($self->{currency}) = split(/:/, $self->{currencies}); + ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency}; } else { $self->lastname_used($dbh, $myconfig, $table, $module); - my $fld = ($table eq 'customer') ? 'buy' : 'sell'; - # get exchangerate for currency $self->{exchangerate} = - $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, - $fld); + $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld); } } - $sth->finish; - - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -2212,42 +2884,61 @@ sub lastname_used { my ($self, $dbh, $myconfig, $table, $module) = @_; - my $arap = ($table eq 'customer') ? "ar" : "ap"; - my $where = "1 = 1"; + my ($arap, $where); + + $table = $table eq "customer" ? "customer" : "vendor"; + my %column_map = ("a.curr" => "currency", + "a.${table}_id" => "${table}_id", + "a.department_id" => "department_id", + "d.description" => "department", + "ct.name" => $table, + "ct.curr" => "cv_curr", + "current_date + ct.terms" => "duedate", + ); + + if ($self->{type} =~ /delivery_order/) { + $arap = 'delivery_orders'; + delete $column_map{"a.curr"}; + delete $column_map{"ct.curr"}; - if ($self->{type} =~ /_order/) { + } elsif ($self->{type} =~ /_order/) { $arap = 'oe'; $where = "quotation = '0'"; - } - if ($self->{type} =~ /_quotation/) { + + } elsif ($self->{type} =~ /_quotation/) { $arap = 'oe'; $where = "quotation = '1'"; + + } elsif ($table eq 'customer') { + $arap = 'ar'; + + } else { + $arap = 'ap'; + } - my $query = qq|SELECT MAX(id) FROM $arap - WHERE $where - AND ${table}_id > 0|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $where = "($where) AND" if ($where); + my $query = qq|SELECT MAX(id) FROM $arap + WHERE $where ${table}_id > 0|; + my ($trans_id) = selectrow_query($self, $dbh, $query); + $trans_id *= 1; - my ($trans_id) = $sth->fetchrow_array; - $sth->finish; + my $column_spec = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map); + $query = qq|SELECT $column_spec + FROM $arap a + LEFT JOIN $table ct ON (a.${table}_id = ct.id) + LEFT JOIN department d ON (a.department_id = d.id) + WHERE a.id = ?|; + my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id); - $trans_id *= 1; - $query = qq|SELECT ct.name, a.curr, a.${table}_id, - current_date + ct.terms AS duedate, a.department_id, - d.description AS department - FROM $arap a - JOIN $table ct ON (a.${table}_id = ct.id) - LEFT JOIN department d ON (a.department_id = d.id) - WHERE a.id = $trans_id|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + map { $self->{$_} = $ref->{$_} } values %column_map; - ($self->{$table}, $self->{currency}, $self->{"${table}_id"}, - $self->{duedate}, $self->{department_id}, $self->{department}) - = $sth->fetchrow_array; - $sth->finish; + # remove any trailing whitespace + $self->{currency} =~ s/\s*$// if $self->{currency}; + $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr}; + + # if customer/vendor currency is set use this + $self->{currency} = $self->{cv_curr} if $self->{cv_curr}; $main::lxdebug->leave_sub(); } @@ -2255,31 +2946,24 @@ sub lastname_used { sub current_date { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $thisdate, $days) = @_; + my $self = shift; + my $myconfig = shift || \%::myconfig; + my ($thisdate, $days) = @_; - my $dbh = $self->dbconnect($myconfig); - my ($sth, $query); + my $dbh = $self->get_standard_dbh($myconfig); + my $query; $days *= 1; if ($thisdate) { my $dateformat = $myconfig->{dateformat}; $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/; - - $query = qq|SELECT to_date('$thisdate', '$dateformat') + $days AS thisdate - FROM defaults|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $thisdate = $dbh->quote($thisdate); + $query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|; } else { - $query = qq|SELECT current_date AS thisdate - FROM defaults|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $query = qq|SELECT current_date AS thisdate|; } - ($thisdate) = $sth->fetchrow_array; - $sth->finish; - - $dbh->disconnect; + ($thisdate) = selectrow_query($self, $dbh, $query); $main::lxdebug->leave_sub(); @@ -2309,15 +2993,14 @@ sub redo_rows { my @ndx = (); - map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } - (1 .. $count); + map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count; my $i = 0; # fill rows foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) { $i++; - $j = $item->{ndx} - 1; + my $j = $item->{ndx} - 1; map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds}; } @@ -2339,47 +3022,45 @@ sub update_status { my $dbh = $self->dbconnect_noauto($myconfig); my $query = qq|DELETE FROM status - WHERE formname = '$self->{formname}' - AND trans_id = ?|; - my $sth = $dbh->prepare($query) || $self->dberror($query); + WHERE (formname = ?) AND (trans_id = ?)|; + my $sth = prepare_query($self, $dbh, $query); if ($self->{formname} =~ /(check|receipt)/) { for $i (1 .. $self->{rowcount}) { - $sth->execute($self->{"id_$i"} * 1) || $self->dberror($query); - $sth->finish; + do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1); } } else { - $sth->execute($self->{id}) || $self->dberror($query); - $sth->finish; + do_statement($self, $sth, $query, $self->{formname}, $self->{id}); } + $sth->finish(); - my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; my %queued = split / /, $self->{queued}; + my @values; if ($self->{formname} =~ /(check|receipt)/) { # this is a check or receipt, add one entry for each lineitem my ($accno) = split /--/, $self->{account}; - $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, - chart_id) VALUES (?, '$printed', - '$queued{$self->{formname}}', '$self->{prinform}', - (SELECT c.id FROM chart c WHERE c.accno = '$accno'))|; - $sth = $dbh->prepare($query) || $self->dberror($query); + $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id) + VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|; + @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno); + $sth = prepare_query($self, $dbh, $query); for $i (1 .. $self->{rowcount}) { if ($self->{"checked_$i"}) { - $sth->execute($self->{"id_$i"}) || $self->dberror($query); - $sth->finish; + do_statement($self, $sth, $query, $self->{"id_$i"}, @values); } } + $sth->finish(); + } else { - $query = qq|INSERT INTO status (trans_id, printed, emailed, - spoolfile, formname) - VALUES ($self->{id}, '$printed', '$emailed', - '$queued{$self->{formname}}', '$self->{formname}')|; - $dbh->do($query) || $self->dberror($query); + $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) + VALUES (?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, + $queued{$self->{formname}}, $self->{formname}); } $dbh->commit; @@ -2388,83 +3069,6 @@ sub update_status { $main::lxdebug->leave_sub(); } -#--- 4 locale ---# -# $main::locale->text('SAVED') -# $main::locale->text('DELETED') -# $main::locale->text('ADDED') -# $main::locale->text('PAYMENT POSTED') -# $main::locale->text('POSTED') -# $main::locale->text('POSTED AS NEW') -# $main::locale->text('ELSE') -# $main::locale->text('SAVED FOR DUNNING') -# $main::locale->text('DUNNING STARTED') -# $main::locale->text('PRINTED') -# $main::locale->text('MAILED') -# $main::locale->text('SCREENED') -# $main::locale->text('invoice') -# $main::locale->text('proforma') -# $main::locale->text('sales_order') -# $main::locale->text('packing_list') -# $main::locale->text('pick_list') -# $main::locale->text('purchase_order') -# $main::locale->text('bin_list') -# $main::locale->text('sales_quotation') -# $main::locale->text('request_quotation') - -sub save_history { - $main::lxdebug->enter_sub(); - - my $self = shift(); - my $dbh = shift(); - - if(!exists $self->{employee_id}) { - &get_employee($self, $dbh); - } - - my $query = - qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done) | . - qq|VALUES (?, ?, ?, ?)|; - my @values = (conv_i($self->{id}), conv_i($self->{employee_id}), - $self->{addition}, $self->{what_done}); - do_query($self, $dbh, $query, @values); - - $main::lxdebug->leave_sub(); -} - -sub get_history { - $main::lxdebug->enter_sub(); - - my $self = shift(); - my $dbh = shift(); - my $trans_id = shift(); - my $restriction = shift(); - my @tempArray; - my $i = 0; - if ($trans_id ne "") { - my $query = - qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name | . - qq|FROM history_erp h | . - qq|LEFT JOIN employee emp | . - qq|ON emp.id = h.employee_id | . - qq|WHERE trans_id = ? | - . $restriction; - - my $sth = $dbh->prepare($query) || $self->dberror($query); - - $sth->execute($trans_id) || $self->dberror("$query ($trans_id)"); - - while(my $hash_ref = $sth->fetchrow_hashref()) { - $hash_ref->{addition} = $main::locale->text($hash_ref->{addition}); - $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done}); - $tempArray[$i++] = $hash_ref; - } - $main::lxdebug->leave_sub() and return \@tempArray - if ($i > 0 && $tempArray[0] ne ""); - } - $main::lxdebug->leave_sub(); - return 0; -} - sub save_status { $main::lxdebug->enter_sub(); @@ -2476,9 +3080,8 @@ sub save_status { my $emailforms = $self->{emailed}; $query = qq|DELETE FROM status - WHERE formname = '$self->{formname}' - AND trans_id = $self->{id}|; - $dbh->do($query) || $self->dberror($query); + WHERE (formname = ?) AND (trans_id = ?)|; + do_query($self, $dbh, $query, $self->{formname}, $self->{id}); # this only applies to the forms # checks and receipts are posted when printed or queued @@ -2487,17 +3090,15 @@ sub save_status { my %queued = split / /, $self->{queued}; foreach my $formname (keys %queued) { - $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; - $query = qq|INSERT INTO status (trans_id, printed, emailed, - spoolfile, formname) - VALUES ($self->{id}, '$printed', '$emailed', - '$queued{$formname}', '$formname')|; - $dbh->do($query) || $self->dberror($query); + $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) + VALUES (?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname); - $formnames =~ s/$self->{formname}//; - $emailforms =~ s/$self->{formname}//; + $formnames =~ s/\Q$self->{formname}\E//; + $emailforms =~ s/\Q$self->{formname}\E//; } } @@ -2511,15 +3112,93 @@ sub save_status { map { $status{$_}{emailed} = 1 } split / +/, $emailforms; foreach my $formname (keys %status) { - $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, formname) - VALUES ($self->{id}, '$printed', '$emailed', '$formname')|; - $dbh->do($query) || $self->dberror($query); + VALUES (?, ?, ?, ?)|; + do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname); + } + + $main::lxdebug->leave_sub(); +} + +#--- 4 locale ---# +# $main::locale->text('SAVED') +# $main::locale->text('DELETED') +# $main::locale->text('ADDED') +# $main::locale->text('PAYMENT POSTED') +# $main::locale->text('POSTED') +# $main::locale->text('POSTED AS NEW') +# $main::locale->text('ELSE') +# $main::locale->text('SAVED FOR DUNNING') +# $main::locale->text('DUNNING STARTED') +# $main::locale->text('PRINTED') +# $main::locale->text('MAILED') +# $main::locale->text('SCREENED') +# $main::locale->text('CANCELED') +# $main::locale->text('invoice') +# $main::locale->text('proforma') +# $main::locale->text('sales_order') +# $main::locale->text('pick_list') +# $main::locale->text('purchase_order') +# $main::locale->text('bin_list') +# $main::locale->text('sales_quotation') +# $main::locale->text('request_quotation') + +sub save_history { + $main::lxdebug->enter_sub(); + + my $self = shift; + my $dbh = shift || $self->get_standard_dbh; + + if(!exists $self->{employee_id}) { + &get_employee($self, $dbh); } + my $query = + qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | . + qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|; + my @values = (conv_i($self->{id}), $self->{login}, + $self->{addition}, $self->{what_done}, "$self->{snumbers}"); + do_query($self, $dbh, $query, @values); + + $dbh->commit; + + $main::lxdebug->leave_sub(); +} + +sub get_history { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $trans_id, $restriction, $order) = @_; + my ($orderBy, $desc) = split(/\-\-/, $order); + $order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " ")); + my @tempArray; + my $i = 0; + if ($trans_id ne "") { + my $query = + qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | . + qq|FROM history_erp h | . + qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | . + qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | . + $order; + + my $sth = $dbh->prepare($query) || $self->dberror($query); + + $sth->execute() || $self->dberror("$query"); + + while(my $hash_ref = $sth->fetchrow_hashref()) { + $hash_ref->{addition} = $main::locale->text($hash_ref->{addition}); + $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done}); + $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g; + $tempArray[$i++] = $hash_ref; + } + $main::lxdebug->leave_sub() and return \@tempArray + if ($i > 0 && $tempArray[0] ne ""); + } $main::lxdebug->leave_sub(); + return 0; } sub update_defaults { @@ -2540,11 +3219,17 @@ sub update_defaults { my ($var) = $sth->fetchrow_array; $sth->finish; - $var++; + if ($var =~ m/\d+$/) { + my $new_var = (substr $var, $-[0]) * 1 + 1; + my $len_diff = length($var) - $-[0] - length($new_var); + $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var; + + } else { + $var = $var . '1'; + } - $query = qq|UPDATE defaults - SET $fld = '$var'|; - $dbh->do($query) || $self->dberror($query); + $query = qq|UPDATE defaults SET $fld = ?|; + do_query($self, $dbh, $query, $var); if (!$provided_dbh) { $dbh->commit; @@ -2568,18 +3253,25 @@ sub update_business { $dbh = $self->dbconnect_noauto($myconfig); } my $query = - qq|SELECT customernumberinit FROM business WHERE id=$business_id FOR UPDATE|; - my $sth = $dbh->prepare($query); + qq|SELECT customernumberinit FROM business + WHERE id = ? FOR UPDATE|; + my ($var) = selectrow_query($self, $dbh, $query, $business_id); - $sth->execute || $self->dberror($query); - my ($var) = $sth->fetchrow_array; - $sth->finish; - if ($var ne "") { - $var++; + return undef unless $var; + + if ($var =~ m/\d+$/) { + my $new_var = (substr $var, $-[0]) * 1 + 1; + my $len_diff = length($var) - $-[0] - length($new_var); + $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var; + + } else { + $var = $var . '1'; } + $query = qq|UPDATE business - SET customernumberinit = '$var' WHERE id=$business_id|; - $dbh->do($query) || $self->dberror($query); + SET customernumberinit = ? + WHERE id = ?|; + do_query($self, $dbh, $query, $var, $business_id); if (!$provided_dbh) { $dbh->commit; @@ -2595,32 +3287,29 @@ sub get_partsgroup { $main::lxdebug->enter_sub(); my ($self, $myconfig, $p) = @_; + my $target = $p->{target} || 'all_partsgroup'; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup FROM partsgroup pg - JOIN parts p ON (p.partsgroup_id = pg.id)|; + JOIN parts p ON (p.partsgroup_id = pg.id) |; + my @values; if ($p->{searchitems} eq 'part') { - $query .= qq| - WHERE p.inventory_accno_id > 0|; + $query .= qq|WHERE p.inventory_accno_id > 0|; } if ($p->{searchitems} eq 'service') { - $query .= qq| - WHERE p.inventory_accno_id IS NULL|; + $query .= qq|WHERE p.inventory_accno_id IS NULL|; } if ($p->{searchitems} eq 'assembly') { - $query .= qq| - WHERE p.assembly = '1'|; + $query .= qq|WHERE p.assembly = '1'|; } if ($p->{searchitems} eq 'labor') { - $query .= qq| - WHERE p.inventory_accno_id > 0 AND p.income_accno_id IS NULL|; + $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|; } - $query .= qq| - ORDER BY partsgroup|; + $query .= qq|ORDER BY partsgroup|; if ($p->{all}) { $query = qq|SELECT id, partsgroup FROM partsgroup @@ -2629,22 +3318,16 @@ sub get_partsgroup { if ($p->{language_code}) { $query = qq|SELECT DISTINCT pg.id, pg.partsgroup, - t.description AS translation + t.description AS translation FROM partsgroup pg - JOIN parts p ON (p.partsgroup_id = pg.id) - LEFT JOIN translation t ON (t.trans_id = pg.id AND t.language_code = '$p->{language_code}') - ORDER BY translation|; + JOIN parts p ON (p.partsgroup_id = pg.id) + LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?)) + ORDER BY translation|; + @values = ($p->{language_code}); } - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values); - $self->{all_partsgroup} = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_partsgroup} }, $ref; - } - $sth->finish; - $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -2653,169 +3336,347 @@ sub get_pricegroup { my ($self, $myconfig, $p) = @_; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT p.id, p.pricegroup FROM pricegroup p|; - $query .= qq| - ORDER BY pricegroup|; + $query .= qq| ORDER BY pricegroup|; if ($p->{all}) { $query = qq|SELECT id, pricegroup FROM pricegroup ORDER BY pricegroup|; } - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub all_years { +# usage $form->all_years($myconfig, [$dbh]) +# return list of all years where bookings found +# (@all_years) - $self->{all_pricegroup} = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_pricegroup} }, $ref; + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $dbh) = @_; + + $dbh ||= $self->get_standard_dbh($myconfig); + + # get years + my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans), + (SELECT MAX(transdate) FROM acc_trans)|; + my ($startdate, $enddate) = selectrow_query($self, $dbh, $query); + + if ($myconfig->{dateformat} =~ /^yy/) { + ($startdate) = split /\W/, $startdate; + ($enddate) = split /\W/, $enddate; + } else { + (@_) = split /\W/, $startdate; + $startdate = $_[2]; + (@_) = split /\W/, $enddate; + $enddate = $_[2]; } - $sth->finish; - $dbh->disconnect; + + my @all_years; + $startdate = substr($startdate,0,4); + $enddate = substr($enddate,0,4); + + while ($enddate >= $startdate) { + push @all_years, $enddate--; + } + + return @all_years; $main::lxdebug->leave_sub(); } -sub audittrail { - my ($self, $dbh, $myconfig, $audittrail) = @_; +sub backup_vars { + $main::lxdebug->enter_sub(); + my $self = shift; + my @vars = @_; - # table, $reference, $formname, $action, $id, $transdate) = @_; + map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars; - my $query; - my $rv; - my $disconnect; + $main::lxdebug->leave_sub(); +} - if (!$dbh) { - $dbh = $self->dbconnect($myconfig); - $disconnect = 1; - } +sub restore_vars { + $main::lxdebug->enter_sub(); - # if we have an id add audittrail, otherwise get a new timestamp + my $self = shift; + my @vars = @_; - if ($audittrail->{id}) { + map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars; - $query = qq|SELECT audittrail FROM defaults|; + $main::lxdebug->leave_sub(); +} - if ($dbh->selectrow_array($query)) { - my ($null, $employee_id) = $self->get_employee($dbh); +sub prepare_for_printing { + my ($self) = @_; - if ($self->{audittrail} && !$myconfig) { - chop $self->{audittrail}; + $self->{templates} ||= $::myconfig{templates}; + $self->{formname} ||= $self->{type}; + $self->{media} ||= 'email'; - my @a = split /\|/, $self->{audittrail}; - my %newtrail = (); - my $key; - my $i; - my @flds = qw(tablename reference formname action transdate); + die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/; - # put into hash and remove dups - while (@a) { - $key = "$a[2]$a[3]"; - $i = 0; - $newtrail{$key} = { map { $_ => $a[$i++] } @flds }; - splice @a, 0, 5; - } + # set shipto from billto unless set + my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact); + if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) { + $self->{shiptoname} = $::myconfig{company}; + $self->{shiptostreet} = $::myconfig{address}; + } - $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, - formname, action, employee_id, transdate) - VALUES ($audittrail->{id}, ?, ?, - ?, ?, $employee_id, ?)|; - my $sth = $dbh->prepare($query) || $self->dberror($query); - - foreach $key ( - sort { - $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} - } keys %newtrail - ) { - $i = 1; - for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) } - - $sth->execute || $self->dberror; - $sth->finish; - } - } + my $language = $self->{language} ? '_' . $self->{language} : ''; - if ($audittrail->{transdate}) { - $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, - formname, action, employee_id, transdate) VALUES ( - $audittrail->{id}, '$audittrail->{tablename}', | - . $dbh->quote($audittrail->{reference}) . qq|, - '$audittrail->{formname}', '$audittrail->{action}', - $employee_id, '$audittrail->{transdate}')|; - } else { - $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, - formname, action, employee_id) VALUES ($audittrail->{id}, - '$audittrail->{tablename}', | - . $dbh->quote($audittrail->{reference}) . qq|, - '$audittrail->{formname}', '$audittrail->{action}', - $employee_id)|; - } - $dbh->do($query); - } + my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates); + if ($self->{language_id}) { + ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id}); } else { + $output_dateformat = $::myconfig{dateformat}; + $output_numberformat = $::myconfig{numberformat}; + $output_longdates = 1; + } - $query = qq|SELECT current_timestamp FROM defaults|; - my ($timestamp) = $dbh->selectrow_array($query); + # Retrieve accounts for tax calculation. + IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount}); - $rv = - "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|"; + if ($self->{type} =~ /_delivery_order$/) { + DO->order_details(); + } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) { + OE->order_details(\%::myconfig, $self); + } else { + IS->invoice_details(\%::myconfig, $self, $::locale); } - $dbh->disconnect if $disconnect; + # Chose extension & set source file name + my $extension = 'html'; + if ($self->{format} eq 'postscript') { + $self->{postscript} = 1; + $extension = 'tex'; + } elsif ($self->{"format"} =~ /pdf/) { + $self->{pdf} = 1; + $extension = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex'; + } elsif ($self->{"format"} =~ /opendocument/) { + $self->{opendocument} = 1; + $extension = 'odt'; + } elsif ($self->{"format"} =~ /excel/) { + $self->{excel} = 1; + $extension = 'xls'; + } - $rv; + my $printer_code = $self->{printer_code} ? '_' . $self->{printer_code} : ''; + my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : ''; + $self->{IN} = "$self->{formname}${email_extension}${language}${printer_code}.${extension}"; -} + # Format dates. + $self->format_dates($output_dateformat, $output_longdates, + qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid + transdate_oe deliverydate_oe employee_startdate employee_enddate), + grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self}))); + $self->reformat_numbers($output_numberformat, 2, + qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid), + grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self}))); -sub all_years { -# usage $form->all_years($myconfig, [$dbh]) -# return list of all years where bookings found -# (@all_years) + $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self}))); - $main::lxdebug->enter_sub(); + my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_'); - my ($self, $myconfig, $dbh) = @_; - - my $disconnect = 0; - if (! $dbh) { - $dbh = $self->dbconnect($myconfig); - $disconnect = 1; + if (scalar @{ $cvar_date_fields }) { + $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields }); } - - # get years - my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans), - (SELECT MAX(transdate) FROM acc_trans) - FROM defaults|; - my ($startdate, $enddate) = $dbh->selectrow_array($query); - if ($myconfig->{dateformat} =~ /^yy/) { - ($startdate) = split /\W/, $startdate; - ($enddate) = split /\W/, $enddate; - } else { - (@_) = split /\W/, $startdate; - $startdate = $_[2]; - (@_) = split /\W/, $enddate; - $enddate = $_[2]; + while (my ($precision, $field_list) = each %{ $cvar_number_fields }) { + $self->reformat_numbers($output_numberformat, $precision, @{ $field_list }); } - my @all_years; - $startdate = substr($startdate,0,4); - $enddate = substr($enddate,0,4); - - while ($enddate >= $startdate) { - push @all_years, $enddate--; + return $self; +} + +sub format_dates { + my ($self, $dateformat, $longformat, @indices) = @_; + + $dateformat ||= $::myconfig{dateformat}; + + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat); + } + } + + next unless defined $self->{$idx}; + + if (!ref($self->{$idx})) { + $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat); + + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat); + } + } } +} - $dbh->disconnect if $disconnect; +sub reformat_numbers { + my ($self, $numberformat, $places, @indices) = @_; - return @all_years; + return if !$numberformat || ($numberformat eq $::myconfig{numberformat}); - $main::lxdebug->leave_sub(); + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]); + } + } + + next unless defined $self->{$idx}; + + if (!ref($self->{$idx})) { + $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx}); + + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]); + } + } + } + + my $saved_numberformat = $::myconfig{numberformat}; + $::myconfig{numberformat} = $numberformat; + + foreach my $idx (@indices) { + if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) { + for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) { + $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places); + } + } + + next unless defined $self->{$idx}; + + if (!ref($self->{$idx})) { + $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places); + + } elsif (ref($self->{$idx}) eq "ARRAY") { + for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) { + $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places); + } + } + } + + $::myconfig{numberformat} = $saved_numberformat; } +sub layout { + my ($self) = @_; + $::lxdebug->enter_sub; + + my %style_to_script_map = ( + v3 => 'v3', + neu => 'new', + v4 => 'v4', + ); + + my $menu_script = $style_to_script_map{$::myconfig{menustyle}} || ''; + + package main; + require "bin/mozilla/menu$menu_script.pl"; + package Form; + require SL::Controller::FrameHeader; + + + my $layout = SL::Controller::FrameHeader->new->action_header . ::render(); + + $::lxdebug->leave_sub; + return $layout; +} 1; + +__END__ + +=head1 NAME + +SL::Form.pm - main data object. + +=head1 SYNOPSIS + +This is the main data object of Lx-Office. +Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points. +Points of interest for a beginner are: + + - $form->error - renders a generic error in html. accepts an error message + - $form->get_standard_dbh - returns a database connection for the + +=head1 SPECIAL FUNCTIONS + +=head2 C PARAMS + +PARAMS (not named): + \%config, - config hashref + $business_id, - business id + $dbh - optional database handle + +handles business (thats customer/vendor types) sequences. + +special behaviour for empty strings in customerinitnumber field: +will in this case not increase the value, and return undef. + +=head2 C $url + +Generates a HTTP redirection header for the new C<$url>. Constructs an +absolute URL including scheme, host name and port. If C<$url> is a +relative URL then it is considered relative to Lx-Office base URL. + +This function Cs if headers have already been created with +C<$::form-Eheader>. + +Examples: + + print $::form->redirect_header('oe.pl?action=edit&id=1234'); + print $::form->redirect_header('http://www.lx-office.org/'); + +=head2 C
+ +Generates a general purpose http/html header and includes most of the scripts +and stylesheets needed. Stylesheets can be added with L. + +Only one header will be generated. If the method was already called in this +request it will not output anything and return undef. Also if no +HTTP_USER_AGENT is found, no header is generated. + +Although header does not accept parameters itself, it will honor special +hashkeys of its Form instance: + +=over 4 + +=item refresh_time + +=item refresh_url + +If one of these is set, a http-equiv refresh is generated. Missing parameters +default to 3 seconds and the refering url. + +=item stylesheet + +Either a scalar or an array ref. Will be inlined into the header. Add +stylesheets with the L function. + +=item landscape + +If true, a css snippet will be generated that sets the page in landscape mode. + +=item favicon + +Used to override the default favicon. + +=item title + +A html page title will be generated from this + +=back + +=cut