X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=381d8152d18496580f439e61ecc081158fd46f60;hb=560d94b29eddbd312fe0eae3726b368959f522eb;hp=62a76e7100c3fcf881e166ffda38bceef6eae945;hpb=ba5f105a984178770a267da4504f4358662d6ffc;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 62a76e710..456cd2e59 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -1,4 +1,4 @@ -#===================================================================== +#==================================================================== # LX-Office ERP # Copyright (C) 2004 # Based on SQL-Ledger Version 2.1.9 @@ -37,82 +37,186 @@ package Form; +#use strict; + +use Data::Dumper; + +use CGI; +use CGI::Ajax; +use Cwd; +use IO::File; +use SL::Auth; +use SL::Auth::DB; +use SL::Auth::LDAP; +use SL::AM; +use SL::Common; +use SL::DBUtils; +use SL::Mailer; +use SL::Menu; +use SL::Template; +use SL::User; +use Template; +use List::Util qw(first max min sum); + +my $standard_dbh; + +END { + if ($standard_dbh) { + $standard_dbh->disconnect(); + undef $standard_dbh; + } +} + +sub _store_value { + $main::lxdebug->enter_sub(2); + + my $curr = shift; + my $key = shift; + my $value = shift; + + while ($key =~ /\[\+?\]\.|\./) { + substr($key, 0, $+[0]) = ''; + + if ($& eq '.') { + $curr->{$`} ||= { }; + $curr = $curr->{$`}; + + } else { + $curr->{$`} ||= [ ]; + if (!scalar @{ $curr->{$`} } || $& eq '[+].') { + push @{ $curr->{$`} }, { }; + } + + $curr = $curr->{$`}->[-1]; + } + } + + $curr->{$key} = $value; + + $main::lxdebug->leave_sub(2); + + return \$curr->{$key}; +} + sub _input_to_hash { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); + + my $params = shift; + my $input = shift; - my $input = $_[0]; - my %in = (); - my @pairs = split(/&/, $input); + my @pairs = split(/&/, $input); foreach (@pairs) { - my ($name, $value) = split(/=/, $_, 2); - $in{$name} = unescape(undef, $value); + my ($key, $value) = split(/=/, $_, 2); + _store_value($params, unescape(undef, $key), unescape(undef, $value)); } - $main::lxdebug->leave_sub(); - - return %in; + $main::lxdebug->leave_sub(2); } sub _request_to_hash { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); + + my $params = shift; + my $input = shift; + + if (!$ENV{'CONTENT_TYPE'} + || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { + + _input_to_hash($params, $input); + + $main::lxdebug->leave_sub(2); + return; + } + + my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); + + my $boundary = '--' . $1; + + foreach my $line (split m/\n/, $input) { + last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); - 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} = $'; #' + if (($line eq $boundary) || ($line eq "$boundary\r")) { + ${ $previous } =~ s|\r?\n$|| if $previous; + + undef $previous; + undef $filename; + + $headers_done = 0; + $content_type = "text/plain"; + $boundary_found = 1; + $need_cr = 0; + + next; + } + + next unless $boundary_found; + + if (!$headers_done) { + $line =~ s/[\r\n]*$//; + + if (!$line) { + $headers_done = 1; + next; + } + + if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) { + if ($line =~ m|filename\s*=\s*"(.*?)"|i) { + $filename = $1; + substr $line, $-[0], $+[0] - $-[0], ""; + } + + if ($line =~ m|name\s*=\s*"(.*?)"|i) { + $name = $1; + substr $line, $-[0], $+[0] - $-[0], ""; } + + $previous = _store_value($params, $name, ''); + $params->{FILENAME} = $filename if ($filename); + + next; } + + if ($line =~ m|^content-type\s*:\s*(.*?)$|i) { + $content_type = $1; + } + + next; } - $main::lxdebug->leave_sub(); - return %ATTACH; + next unless $previous; + + ${ $previous } .= "${line}\n"; + } + + ${ $previous } =~ s|\r?\n$|| if $previous; + $main::lxdebug->leave_sub(2); +} + +sub _recode_recursively { + $main::lxdebug->enter_sub(); + my ($iconv, $param) = @_; + + if (ref $param eq 'HASH') { + foreach my $key (keys %{ $param }) { + if (!ref $param->{$key}) { + $param->{$key} = $iconv->convert($param->{$key}); } else { - $main::lxdebug->leave_sub(); - return _input_to_hash($input); + _recode_recursively($iconv, $param->{$key}); + } + } + + } elsif (ref $param eq 'ARRAY') { + foreach my $idx (0 .. scalar(@{ $param }) - 1) { + if (!ref $param->[$idx]) { + $param->[$idx] = $iconv->convert($param->[$idx]); + } else { + _recode_recursively($iconv, $param->[$idx]); + } + } } + $main::lxdebug->leave_sub(); } sub new { @@ -122,6 +226,11 @@ sub new { my $self = {}; + if ($LXDebug::watch_form) { + require SL::Watchdog; + tie %{ $self }, 'SL::Watchdog'; + } + read(STDIN, $_, $ENV{CONTENT_LENGTH}); if ($ENV{QUERY_STRING}) { @@ -132,20 +241,101 @@ sub new { $_ = $ARGV[0]; } - my %parameters = _request_to_hash($_); - map({ $self->{$_} = $parameters{$_}; } keys(%parameters)); + bless $self, $type; + + my $parameters = { }; + _request_to_hash($parameters, $_); - $self->{menubar} = 1 if $self->{path} =~ /lynx/i; + my $db_charset = $main::dbcharset; + $db_charset ||= Common::DEFAULT_CHARSET; - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|#)/_/g; + if ($parameters->{INPUT_ENCODING} && (lc $parameters->{INPUT_ENCODING} ne $db_charset)) { + require Text::Iconv; + my $iconv = Text::Iconv->new($parameters->{INPUT_ENCODING}, $db_charset); - $self->{version} = "2.1.2"; - $self->{dbversion} = "2.1.2"; + _recode_recursively($iconv, $parameters); + + delete $parameters{INPUT_ENCODING}; + } + + map { $self->{$_} = $parameters->{$_}; } keys %{ $parameters }; + + $self->{action} = lc $self->{action}; + $self->{action} =~ s/( |-|,|\#)/_/g; + + $self->{version} = "2.6.0 beta 2"; $main::lxdebug->leave_sub(); - bless $self, $type; + return $self; +} + +sub _flatten_variables_rec { + $main::lxdebug->enter_sub(2); + + 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); + } + + } else { + foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) { + my $first_array_entry = 1; + + 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; + } + } + } + + $main::lxdebug->leave_sub(2); + + return @result; +} + +sub flatten_variables { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my @keys = @_; + + my @variables; + + foreach (@keys) { + push @variables, $self->_flatten_variables_rec($self, '', $_); + } + + $main::lxdebug->leave_sub(2); + + return @variables; +} + +sub flatten_standard_variables { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_); + + my @variables; + + foreach (grep { ! $skip_keys{$_} } keys %{ $self }) { + push @variables, $self->_flatten_variables_rec($self, '', $_); + } + + $main::lxdebug->leave_sub(2); + + return @variables; } sub debug { @@ -160,25 +350,38 @@ sub debug { $main::lxdebug->leave_sub(); } -sub escape { - $main::lxdebug->enter_sub(); +sub dumper { + $main::lxdebug->enter_sub(2); - my ($self, $str, $beenthere) = @_; + my $self = shift; + my $password = $self->{password}; - # for Apache 2 we escape strings twice - #if (($ENV{SERVER_SOFTWARE} =~ /Apache\/2/) && !$beenthere) { - # $str = $self->escape($str, 1); - #} + $self->{password} = 'X' x 8; + + local $Data::Dumper::Sortkeys = 1; + my $output = Dumper($self); + + $self->{password} = $password; + + $main::lxdebug->leave_sub(2); + + return $output; +} + +sub escape { + $main::lxdebug->enter_sub(2); + + my ($self, $str) = @_; $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $str; } sub unescape { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $str) = @_; @@ -187,42 +390,66 @@ sub unescape { $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $str; } -sub error { +sub quote { $main::lxdebug->enter_sub(); + my ($self, $str) = @_; - my ($self, $msg) = @_; + if ($str && !ref($str)) { + $str =~ s/\"/"/g; + } - if ($ENV{HTTP_USER_AGENT}) { - $msg =~ s/\n/
/g; + $str; - $self->header; + $main::lxdebug->leave_sub(); +} - print qq| - +sub unquote { + $main::lxdebug->enter_sub(); + my ($self, $str) = @_; -

Error!

+ if ($str && !ref($str)) { + $str =~ s/"/\"/g; + } -

$msg + $str; - - - |; + $main::lxdebug->leave_sub(); +} - die "Error: $msg\n"; +sub hide_form { + $main::lxdebug->enter_sub(); + my $self = shift; + if (@_) { + map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_); } else { - - if ($self->{error_function}) { - &{ $self->{error_function} }($msg); - } else { - die "Error: $msg\n"; + for (sort keys %$self) { + next if (($_ eq "header") || (ref($self->{$_}) ne "")); + print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } } + $main::lxdebug->leave_sub(); +} + +sub error { + $main::lxdebug->enter_sub(); + + $main::lxdebug->show_backtrace(); + + my ($self, $msg) = @_; + if ($ENV{HTTP_USER_AGENT}) { + $msg =~ s/\n/
/g; + $self->show_generic_error($msg); + + } else { + + die "Error: $msg\n"; + } $main::lxdebug->leave_sub(); } @@ -258,20 +485,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) = @_; - - my $rows = 0; + $minrows ||= 1; - 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 { @@ -289,65 +516,119 @@ 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 create_http_response { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; + + my $cgi = $main::cgi; + $cgi ||= CGI->new(''); + + my $base_path; + + if ($ENV{HTTP_X_FORWARDED_FOR}) { + $base_path = $ENV{HTTP_REFERER}; + $base_path =~ s|^.*?://.*?/|/|; + } else { + $base_path = $ENV{REQUEST_URI}; + } + $base_path =~ s|[^/]+$||; + $base_path =~ s|/$||; + + my $session_cookie; + if (defined $main::auth) { + my $session_cookie_value = $main::auth->get_session_id(); + $session_cookie_value ||= 'NO_SESSION'; + + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $base_path); } + + my %cgi_params = ('-type' => $params{content_type}); + $cgi_params{'-charset'} = $params{charset} if ($params{charset}); + + my $output = $cgi->header('-cookie' => $session_cookie, + %cgi_params); + $main::lxdebug->leave_sub(); + + return $output; } + sub header { $main::lxdebug->enter_sub(); - my ($self) = @_; + my ($self, $extra_code) = @_; if ($self->{header}) { $main::lxdebug->leave_sub(); return; } - my ($stylesheet, $favicon, $charset); + my ($stylesheet, $favicon, $pagelayout); if ($ENV{HTTP_USER_AGENT}) { + my $doctype; - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = - qq| - |; + if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) { + # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise. + $doctype = qq|\n|; } + my $stylesheets = "$self->{stylesheet} $self->{stylesheets}"; + + $stylesheets =~ s|^\s*||; + $stylesheets =~ s|\s*$||; + foreach my $file (split m/\s+/, $stylesheets) { + $file =~ s|.*/||; + next if (! -f "css/$file"); + + $stylesheet .= qq|\n|; + } + + $self->{favicon} = "favicon.ico" unless $self->{favicon}; + if ($self->{favicon} && (-f "$self->{favicon}")) { $favicon = qq| |; } - if ($self->{charset}) { - $charset = - qq| - |; - } + my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; + if ($self->{landscape}) { $pagelayout = qq||; } - if ($self->{fokus}) { - $fokus = qq||; - } + + my $fokus = qq| document.$self->{fokus}.focus();| if ($self->{"fokus"}); #Set Calendar - $jsscript = ""; + my $jsscript = ""; if ($self->{jsscript} == 1) { $jsscript = qq| + + + + $self->{javascript} |; } @@ -355,17 +636,46 @@ function fokus(){document.$self->{fokus}.focus();} ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; + my $ajax = ""; + foreach my $item (@ { $self->{AJAX} }) { + $ajax .= $item->show_javascript(); + } - print qq|Content-Type: text/html - + print $self->create_http_response('content_type' => 'text/html', + 'charset' => $db_charset,); + print qq|${doctype} + $self->{titlebar} $stylesheet $pagelayout $favicon - $charset $jsscript - $fokus + $ajax + + + + + + + + + + $extra_code |; @@ -375,511 +685,560 @@ function fokus(){document.$self->{fokus}.focus();} $main::lxdebug->leave_sub(); } -# write Trigger JavaScript-Code ($qty = 1 - only one Trigger) -sub write_trigger { +sub ajax_response_header { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $qty, - $inputField_1, $align_1, $button_1, - $inputField_2, $align_2, $button_2) - = @_; - - # set dateform for jsscript - # default - $ifFormat = "%d.%m.%Y"; - if ($myconfig->{dateformat} eq "dd.mm.yy") { - $ifFormat = "%d.%m.%Y"; - } else { - if ($myconfig->{dateformat} eq "dd-mm-yy") { - $ifFormat = "%d-%m-%Y"; - } else { - if ($myconfig->{dateformat} eq "dd/mm/yy") { - $ifFormat = "%d/%m/%Y"; - } else { - if ($myconfig->{dateformat} eq "mm/dd/yy") { - $ifFormat = "%m/%d/%Y"; - } else { - if ($myconfig->{dateformat} eq "mm-dd-yy") { - $ifFormat = "%m-%d-%Y"; - } else { - if ($myconfig->{dateformat} eq "yyyy-mm-dd") { - $ifFormat = "%Y-%m-%d"; - } - } - } - } - } - } - - $trigger_1 = qq| - Calendar.setup( -  { -    inputField  : "$inputField_1", -    ifFormat    :"$ifFormat", -    align    : "$align_1",      -    button      : "$button_1" -  } -  ); - |; + my ($self) = @_; - if ($qty == 2) { - $trigger_2 = qq| - Calendar.setup( - { -     inputField  : "$inputField_2", -     ifFormat    :"$ifFormat", -    align    : "$align_2",      -    button      : "$button_2" -  } -  ); - |; - } - $jsscript = qq| - - |; + my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; + my $cgi = $main::cgi || CGI->new(''); + my $output = $cgi->header('-charset' => $db_charset); $main::lxdebug->leave_sub(); - return $jsscript; -} #end sub write_trigger + return $output; +} -sub redirect { +sub _prepare_html_template { $main::lxdebug->enter_sub(); - my ($self, $msg) = @_; - - if ($self->{callback}) { + my ($self, $file, $additional_params) = @_; + my $language; - ($script, $argv) = split(/\?/, $self->{callback}); - exec("perl", "$script", $argv); + if (!defined(%main::myconfig) || !defined($main::myconfig{"countrycode"})) { + $language = $main::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 = "Developer 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") { + $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); + } - $self->info($msg); - exit; + if ($self->{"DEBUG"}) { + $additional_params->{"DEBUG"} = $self->{"DEBUG"}; } - $main::lxdebug->leave_sub(); -} + if ($additional_params->{"DEBUG"}) { + $additional_params->{"DEBUG"} = + "
DEBUG INFORMATION:
" . $additional_params->{"DEBUG"} . "
"; + } -# sort of columns removed - empty sub -sub sort_columns { - $main::lxdebug->enter_sub(); + 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; + } - my ($self, @columns) = @_; + $additional_params->{"conf_dbcharset"} = $main::dbcharset; + $additional_params->{"conf_webdav"} = $main::webdav; + $additional_params->{"conf_lizenzen"} = $main::lizenzen; + $additional_params->{"conf_latex_templates"} = $main::latex; + $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates; + + if (%main::debug_options) { + map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::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; + } + } $main::lxdebug->leave_sub(); - return @columns; + return $file; } -sub format_amount { +sub parse_html_template { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $amount, $places, $dash) = @_; + my ($self, $file, $additional_params) = @_; - if ($places =~ /\d/) { - $amount = $self->round_amount($amount, $places); - } + $additional_params ||= { }; - # is the amount negative - my $negative = ($amount < 0); + $file = $self->_prepare_html_template($file, $additional_params); - if ($amount != 0) { - if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) - { - my ($whole, $dec) = split /\./, "$amount"; - $whole =~ s/-//; - $amount = join '', reverse split //, $whole; + my $template = Template->new({ 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', + }) || die; - if ($myconfig->{numberformat} eq '1,000.00') { - $amount =~ s/\d{3,}?/$&,/g; - $amount =~ s/,$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" if ($dec ne ""); - } + map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; - if ($myconfig->{numberformat} eq '1.000,00') { - $amount =~ s/\d{3,}?/$&./g; - $amount =~ s/\.$//; - $amount = join '', reverse split //, $amount; - $amount .= ",$dec" if ($dec ne ""); - } + my $in = IO::File->new($file, 'r'); - if ($myconfig->{numberformat} eq '1000,00') { - $amount = "$whole"; - $amount .= ",$dec" if ($dec ne ""); - } + if (!$in) { + print STDERR "Error opening template file: $!"; + $main::lxdebug->leave_sub(); + return ''; + } - if ($dash =~ /-/) { - $amount = ($negative) ? "($amount)" : "$amount"; - } elsif ($dash =~ /DRCR/) { - $amount = ($negative) ? "$amount DR" : "$amount CR"; - } else { - $amount = ($negative) ? "-$amount" : "$amount"; - } - } - } else { - if ($dash eq "0" && $places) { - if ($myconfig->{numberformat} eq '1.000,00') { - $amount = "0" . "," . "0" x $places; - } else { - $amount = "0" . "." . "0" x $places; - } - } else { - $amount = ($dash ne "") ? "$dash" : "0"; - } + my $input = join('', <$in>); + $in->close(); + + if ($main::locale) { + $input = $main::locale->{iconv}->convert($input); + } + + my $output; + if (!$template->process(\$input, $additional_params, \$output)) { + print STDERR $template->error(); } $main::lxdebug->leave_sub(); - return $amount; + return $output; } -sub parse_amount { +sub show_generic_error { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $amount) = @_; + my ($self, $error, %params) = @_; - if (!(substr($amount, -3, 1) eq ".")) { - if ( ($myconfig->{numberformat} eq '1.000,00') - || ($myconfig->{numberformat} eq '1000,00')) { - $amount =~ s/\.//g; - $amount =~ s/,/\./; - } + my $add_params = { + 'title_error' => $params{title}, + 'label_error' => $error, + }; - $amount =~ s/,//g; + 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; + + } elsif ($params{back_button}) { + $add_params->{SHOW_BACK_BUTTON} = 1; } + $self->{title} = $params{title} if $params{title}; + + $self->header(); + print $self->parse_html_template("generic/error", $add_params); + $main::lxdebug->leave_sub(); - return ($amount * 1); + die("Error: $error\n"); } -sub round_amount { +sub show_generic_information { $main::lxdebug->enter_sub(); - my ($self, $amount, $places) = @_; - my $rc; + my ($self, $text, $title) = @_; - # $places = 3 if $places == 2; + my $add_params = { + 'title_information' => $title, + 'label_information' => $text, + }; - if (($places * 1) >= 0) { + $self->{title} = $title if ($title); - # add 1/10^$places+3 - $rc = - sprintf("%.${places}f", - $amount + (1 / (10**($places + 3))) * (($amount > 0) ? 1 : -1)); - } else { - $places *= -1; - $rc = - sprintf("%.f", $amount / (10**$places) + (($amount > 0) ? 0.1 : -0.1)) * - (10**$places); - } + $self->header(); + print $self->parse_html_template("generic/information", $add_params); $main::lxdebug->leave_sub(); - return $rc; + die("Information: $text\n"); } -sub parse_template { +# write Trigger JavaScript-Code ($qty = quantity of Triggers) +# changed it to accept an arbitrary number of triggers - sschoeling +sub write_trigger { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $userspath) = @_; + my $self = shift; + my $myconfig = shift; + my $qty = shift; - # { Moritz Bunkus - # Some variables used for page breaks - my ($chars_per_line, $lines_on_first_page, $lines_on_second_page) = - (0, 0, 0); - my ($current_page, $current_line) = (1, 1); - my $pagebreak = ""; - my $sum = 0; + # set dateform for jsscript + # 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 @triggers; + while ($#_ >= 2) { + push @triggers, qq| + Calendar.setup( + { + inputField : "| . (shift) . qq|", + ifFormat :"$ifFormat", + align : "| . (shift) . qq|", + button : "| . (shift) . qq|" + } + ); + |; + } + my $jsscript = qq| + + |; - # } Moritz Bunkus + $main::lxdebug->leave_sub(); - # Make sure that all *notes* (intnotes, partnotes_*, notes etc) are converted to markup correctly. - $self->format_string(grep(/notes/, keys(%{$self}))); + return $jsscript; +} #end sub write_trigger - # 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" }; +sub redirect { + $main::lxdebug->enter_sub(); - map({ $self->{"employee_${_}"} = $myconfig->{$_}; } - qw(email tel fax name signature)); + my ($self, $msg) = @_; - open(IN, "$self->{templates}/$self->{IN}") - or $self->error("$self->{IN} : $!"); + if ($self->{callback}) { - @_ = ; - close(IN); + my ($script, $argv) = split(/\?/, $self->{callback}, 2); + $script =~ s|.*/||; + $script =~ s|[^a-zA-Z0-9_\.]||g; + exec("perl", "$script", $argv); - $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); + } else { - # 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->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { - $out = $self->{OUT}; - $self->{OUT} = ">$self->{tmpfile}"; + $self->info($msg); + exit; } - if ($self->{OUT}) { - open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); - } else { - open(OUT, ">-") or $self->error("STDOUT : $!"); - $self->header; - } + $main::lxdebug->leave_sub(); +} + +# sort of columns removed - empty sub +sub sort_columns { + $main::lxdebug->enter_sub(); + + my ($self, @columns) = @_; + + $main::lxdebug->leave_sub(); + + return @columns; +} +# +sub format_amount { + $main::lxdebug->enter_sub(2); - # Do we have to run LaTeX two times? This is needed if - # the template contains page references. - $two_passes = 0; + my ($self, $myconfig, $amount, $places, $dash) = @_; - # first we generate a tmpfile - # read file and replace <%variable%> - while ($_ = shift) { + if ($amount eq "") { + $amount = 0; + } - $par = ""; - $var = $_; + # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13 - $two_passes = 1 if (/\\pageref/); + my $neg = ($amount =~ s/^-//); + my $exp = ($amount =~ m/[e]/) ? 1 : 0; - # { Moritz Bunkus - # detect pagebreak block and its parameters - if (/\s*<%pagebreak ([0-9]+) ([0-9]+) ([0-9]+)%>/) { - $chars_per_line = $1; - $lines_on_first_page = $2; - $lines_on_second_page = $3; + if (defined($places) && ($places ne '')) { + if (not $exp) { + if ($places < 0) { + $amount *= 1; + $places *= -1; - while ($_ = shift) { - last if (/\s*<%end pagebreak%>/); - $pagebreak .= $_; + my ($actual_places) = ($amount =~ /\.(\d+)/); + $actual_places = length($actual_places); + $places = $actual_places > $places ? $actual_places : $places; } } + $amount = $self->round_amount($amount, $places); + } - # } Moritz Bunkus + my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars + my @p = split(/\./, $amount); # split amount at decimal point - if (/\s*<%foreach /) { + $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters - # this one we need for the count - chomp $var; - $var =~ s/\s*<%foreach (.+?)%>/$1/; - while ($_ = shift) { - last if (/\s*<%end /); + $amount = $p[0]; + $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); - # store line in $par - $par .= $_; - } + $amount = do { + ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : + ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) : + ($neg ? "-$amount" : "$amount" ) ; + }; - # display contents of $self->{number}[] array - for $i (0 .. $#{ $self->{$var} }) { - - # { Moritz Bunkus - # Try to detect whether a manual page break is necessary - # but only if there was a <%pagebreak ...%> block before - - if ($chars_per_line) { - my $lines = - int(length($self->{"description"}[$i]) / $chars_per_line + 0.95); - my $lpp; - - my $_description = $self->{"description"}[$i]; - while ($_description =~ /\\newline/) { - $lines++; - $_description =~ s/\\newline//; - } - $self->{"description"}[$i] =~ s/(\\newline\s?)*$//; - - if ($current_page == 1) { - $lpp = $lines_on_first_page; - } else { - $lpp = $lines_on_second_page; - } - - # Yes we need a manual page break - if (($current_line + $lines) > $lpp) { - my $pb = $pagebreak; - - # replace the special variables <%sumcarriedforward%> - # and <%lastpage%> - - my $psum = $self->format_amount($myconfig, $sum, 2); - $pb =~ s/<%sumcarriedforward%>/$psum/g; - $pb =~ s/<%lastpage%>/$current_page/g; - - # only "normal" variables are supported here - # (no <%if, no <%foreach, no <%include) - - $pb =~ s/<%(.+?)%>/$self->{$1}/g; - - # page break block is ready to rock - print(OUT $pb); - $current_page++; - $current_line = 1; - } - $current_line += $lines; - } - $sum += $self->parse_amount($myconfig, $self->{"linetotal"}[$i]); - # } Moritz Bunkus + $main::lxdebug->leave_sub(2); + return $amount; +} - # don't parse par, we need it for each line - $_ = $par; - s/<%(.+?)%>/$self->{$1}[$i]/mg; - print OUT; - } - next; - } +sub format_amount_units { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; - # if not comes before if! - if (/\s*<%if not /) { + 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}; - # check if it is not set and display - chop; - s/\s*<%if not (.+?)%>/$1/; + if (!$part_unit_name) { + $main::lxdebug->leave_sub(); + return ''; + } - unless ($self->{$_}) { - while ($_ = shift) { - last if (/\s*<%end /); + AM->retrieve_all_units(); + my $all_units = $main::all_units; - # store line in $par - $par .= $_; - } + if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) { + $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller'); + } - $_ = $par; + if (!scalar @{ $conv_units }) { + my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name; + $main::lxdebug->leave_sub(); + return $result; + } - } else { - while ($_ = shift) { - last if (/\s*<%end /); - } - next; - } + 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; + + $amount *= $conv_unit->{factor}; + + my @values; + my $num; + + foreach my $unit (@$conv_units) { + my $last = $unit->{name} eq $part_unit->{name}; + if (!$last) { + $num = int($amount / $unit->{factor}); + $amount -= $num * $unit->{factor}; + } + + if ($last ? $amount : $num) { + push @values, { "unit" => $unit->{name}, + "amount" => $last ? $amount / $unit->{factor} : $num, + "places" => $last ? $places : 0 }; } - if (/\s*<%if /) { + last if $last; + } - # check if it is set and display - chop; - s/\s*<%if (.+?)%>/$1/; + if (!@values) { + push @values, { "unit" => $part_unit_name, + "amount" => 0, + "places" => 0 }; + } - if ($self->{$_}) { - while ($_ = shift) { - last if (/\s*<%end /); + my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values; - # store line in $par - $par .= $_; - } + $main::lxdebug->leave_sub(); - $_ = $par; + return $result; +} - } else { - while ($_ = shift) { - last if (/\s*<%end /); - } - next; - } - } +sub format_string { + $main::lxdebug->enter_sub(2); - # check for <%include filename%> - if (/\s*<%include /) { + my $self = shift; + my $input = shift; - # get the filename - chomp $var; - $var =~ s/\s*<%include (.+?)%>/$1/; + $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx; + $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx; + $input =~ s/\#\#/\#/g; - # mangle filename - $var =~ s/(\/|\.\.)//g; + $main::lxdebug->leave_sub(2); - # prevent the infinite loop! - next if ($self->{"$var"}); + return $input; +} - open(INC, "$self->{templates}/$var") - or $self->error($self->cleanup . "$self->{templates}/$var : $!"); - unshift(@_, ); - close(INC); +# - $self->{"$var"} = 1; +sub parse_amount { + $main::lxdebug->enter_sub(2); - next; - } + my ($self, $myconfig, $amount) = @_; - s/<%(.+?)%>/$self->{$1}/g; - print OUT; + if ( ($myconfig->{numberformat} eq '1.000,00') + || ($myconfig->{numberformat} eq '1000,00')) { + $amount =~ s/\.//g; + $amount =~ s/,/\./; } - close(OUT); + if ($myconfig->{numberformat} eq "1'000.00") { + $amount =~ s/\'//g; + } - # { Moritz Bunkus - # Convert the tex file to postscript - if ($self->{format} =~ /(postscript|pdf)/) { + $amount =~ s/,//g; - use Cwd; - $self->{cwd} = cwd(); - $self->{tmpdir} = "$self->{cwd}/$userspath"; + $main::lxdebug->leave_sub(2); - chdir("$userspath") or $self->error($self->cleanup . "chdir : $!"); + return ($amount * 1); +} - $self->{tmpfile} =~ s/$userspath\///g; +sub round_amount { + $main::lxdebug->enter_sub(2); - if ($self->{format} eq 'postscript') { - system( - "latex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err" - ); - $self->error($self->cleanup) if ($?); - if ($two_passes) { - system( - "latex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err" - ); - $self->error($self->cleanup) if ($?); - } + my ($self, $amount, $places) = @_; + my $round_amount; - $self->{tmpfile} =~ s/tex$/dvi/; + # 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)); - system("dvips $self->{tmpfile} -o -q > /dev/null"); - $self->error($self->cleanup . "dvips : $!") if ($?); - $self->{tmpfile} =~ s/dvi$/ps/; - } - if ($self->{format} eq 'pdf') { - system( - "pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err" - ); - $self->error($self->cleanup) if ($?); - if ($two_passes) { - system( - "pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err" - ); - $self->error($self->cleanup) if ($?); - } - $self->{tmpfile} =~ s/tex$/pdf/; - } + $main::lxdebug->leave_sub(2); + + return $round_amount; + +} + +sub parse_template { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $userspath) = @_; + my ($template, $out); + + local (*IN, *OUT); + + $self->{"cwd"} = getcwd(); + $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + + my $ext_for_format; + + if ($self->{"format"} =~ /(opendocument|oasis)/i) { + $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'odt'; + + } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { + $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; + $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'pdf'; + + } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { + $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'html'; + + } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + $ext_for_format = 'xml'; + + } 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); + + } 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'}"); + } + + # 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" }; + if (!$self->{employee_id}) { + map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns); } - if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid); - if ($self->{media} eq 'email') { + $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; + my $prepend_userspath; + + if (!$self->{tmpfile}) { + $self->{tmpfile} = "${fileid}.$self->{IN}"; + $prepend_userspath = 1; + } + + $prepend_userspath = 1 if substr($self->{tmpfile}, 0, length $userspath) eq $userspath; + + $self->{tmpfile} =~ s|.*/||; + $self->{tmpfile} =~ s/[^a-zA-Z0-9\._\ \-]//g; + $self->{tmpfile} = "$userspath/$self->{tmpfile}" if $prepend_userspath; + + if ($template->uses_temp_file() || $self->{media} eq 'email') { + $out = $self->{OUT}; + $self->{OUT} = ">$self->{tmpfile}"; + } + + if ($self->{OUT}) { + open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); + } else { + open(OUT, ">-") or $self->error("STDOUT : $!"); + $self->header; + } + + if (!$template->parse(*OUT)) { + $self->cleanup(); + $self->error("$self->{IN} : " . $template->get_error()); + } + + close(OUT); + + if ($template->uses_temp_file() || $self->{media} eq 'email') { - use SL::Mailer; + if ($self->{media} eq 'email') { 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} = $main::dbcharset ? $main::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//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->{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}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); @@ -891,14 +1250,19 @@ sub parse_template { } else { - @{ $mail->{attachments} } = ($self->{tmpfile}); + if (!$self->{"do_not_attach"}) { + 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 }]; + } - $myconfig->{signature} =~ s/\\n/\r\n/g; - $mail->{message} .= "\r\n--\r\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 { @@ -912,16 +1276,20 @@ sub parse_template { $self->{copies} = 1 unless $self->{media} eq 'printer'; chdir("$self->{cwd}"); - + #print(STDERR "Kopien $self->{copies}\n"); + #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} : $!"); } else { + $self->{attachment_filename} = ($self->{attachment_filename}) + ? $self->{attachment_filename} + : $self->generate_attachment_filename(); # launch application - print qq|Content-Type: application/$self->{format} -Content-Disposition: attachment; filename="$self->{tmpfile}" + print qq|Content-Type: | . $template->get_mime_type() . qq| +Content-Disposition: attachment; filename="$self->{attachment_filename}" Content-Length: $numbytes |; @@ -942,14 +1310,108 @@ Content-Length: $numbytes close(IN); } - $self->cleanup; - } + $self->cleanup; + chdir("$self->{cwd}"); $main::lxdebug->leave_sub(); } +sub get_formname_translation { + $main::lxdebug->enter_sub(); + my ($self, $formname) = @_; + + $formname ||= $self->{formname}; + + my %formname_translations = ( + bin_list => $main::locale->text('Bin List'), + credit_note => $main::locale->text('Credit Note'), + invoice => $main::locale->text('Invoice'), + packing_list => $main::locale->text('Packing List'), + 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'), + storno_packing_list => $main::locale->text('Storno Packing List'), + sales_delivery_order => $main::locale->text('Delivery Order'), + purchase_delivery_order => $main::locale->text('Delivery Order'), + ); + + $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} =~ /html/i ? ".html" + : ""; + + $main::lxdebug->leave_sub(); + return $extension; +} + +sub generate_attachment_filename { + $main::lxdebug->enter_sub(); + my ($self) = @_; + + 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 .= ' (' . $main::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(); @@ -965,7 +1427,7 @@ sub cleanup { } if ($self->{tmpfile}) { - + $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; my $tmpfile = $self->{tmpfile}; @@ -979,69 +1441,11 @@ sub cleanup { return "@err"; } -sub format_string { - $main::lxdebug->enter_sub(); - - my ($self, @fields) = @_; - my %unique_fields; - - %unique_fields = map({ $_ => 1 } @fields); - @fields = keys(%unique_fields); - my $format = $self->{format}; - if ($self->{format} =~ /(postscript|pdf)/) { - $format = 'tex'; - } - - my %replace = ( - 'order' => { - 'html' => [ - '<', '>', quotemeta('\n'), ' -' - ], - 'tex' => [ - '&', quotemeta('\n'), ' -', - '"', '\$', '%', '_', '#', quotemeta('^'), - '{', '}', '<', '>', '£', "\r" - ] - }, - 'html' => { - '<' => '<', - '>' => '>', - quotemeta('\n') => '
', - ' -' => '
' - }, - 'tex' => { - '"' => "''", - '&' => '\&', - '\$' => '\$', - '%' => '\%', - '_' => '\_', - '#' => '\#', - quotemeta('^') => '\^\\', - '{' => '\{', - '}' => '\}', - '<' => '$<$', - '>' => '$>$', - quotemeta('\n') => '\newline ', - ' -' => '\newline ', - '£' => '\pounds ', - "\r" => "" - }); - - foreach my $key (@{ $replace{order}{$format} }) { - map { $self->{$_} =~ s/$key/$replace{$format}{$key}/g; } @fields; - } - - $main::lxdebug->leave_sub(); -} - sub datetonum { $main::lxdebug->enter_sub(); my ($self, $date, $myconfig) = @_; + my ($yy, $mm, $dd); if ($date && $date =~ /\D/) { @@ -1074,7 +1478,7 @@ sub datetonum { # Database routines used throughout sub dbconnect { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig) = @_; @@ -1089,7 +1493,7 @@ sub dbconnect { $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $dbh; } @@ -1100,7 +1504,7 @@ sub dbconnect_noauto { my ($self, $myconfig) = @_; # connect to database - $dbh = + my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, { AutoCommit => 0 }) or $self->dberror; @@ -1115,27 +1519,57 @@ sub dbconnect_noauto { return $dbh; } -sub update_balance { - $main::lxdebug->enter_sub(); +sub get_standard_dbh { + $main::lxdebug->enter_sub(2); - my ($self, $dbh, $table, $field, $where, $value) = @_; + my ($self, $myconfig) = @_; - # if we have a value, go do it - if ($value != 0) { + 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; + } - # retrieve balance from table - my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; - my $sth = $dbh->prepare($query); + $standard_dbh ||= $self->dbconnect_noauto($myconfig); - $sth->execute || $self->dberror($query); - my ($balance) = $sth->fetchrow_array; + $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, $date); + 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, @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 = prepare_execute_query($self, $dbh, $query, @values); + my ($balance) = $sth->fetchrow_array; $sth->finish; $balance += $value; # 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(); } @@ -1144,19 +1578,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 ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; - 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); + + 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) { @@ -1170,14 +1622,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(); } @@ -1189,12 +1642,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(); @@ -1204,15 +1660,28 @@ sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ($query); + + unless ($transdate) { + $main::lxdebug->leave_sub(); + return 1; + } + + $query = qq|SELECT curr FROM defaults|; + + my ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; + + if ($currency eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return 1; + } + + $query = qq|SELECT e.$fld FROM exchangerate e + WHERE e.curr = ? AND e.transdate = ?|; + my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); - 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); - my ($exchangerate) = $sth->fetchrow_array; - $sth->finish; $main::lxdebug->leave_sub(); @@ -1224,54 +1693,266 @@ 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_default_currency { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + my $dbh = $self->get_standard_dbh($myconfig); + + my $query = qq|SELECT curr FROM defaults|; + + my ($curr) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $curr; + + $main::lxdebug->leave_sub(); + + return $defaultcurrency; +} + + +sub set_payment_options { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $transdate) = @_; + + return $main::lxdebug->leave_sub() unless ($self->{payment_id}); + + my $dbh = $self->get_standard_dbh($myconfig); + + my $query = + qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, 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 + ?::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}); + + my ($invtotal, $total); + my (%amounts, %formatted_amounts); + + if ($self->{type} =~ /_order$/) { + $amounts{invtotal} = $self->{ordtotal}; + $amounts{total} = $self->{ordtotal}; + + } elsif ($self->{type} =~ /_quotation$/) { + $amounts{invtotal} = $self->{quototal}; + $amounts{total} = $self->{quototal}; + + } else { + $amounts{invtotal} = $self->{invtotal}; + $amounts{total} = $self->{total}; + } + + map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts; + + $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); + } + + if ($self->{"language_id"}) { + $query = + qq|SELECT t.description_long, 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; + 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; + + $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) = @_; -##LINET + my ($self, $dbh, $id, $module) = @_; + 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 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) { - my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet, - shiptozipcode, shiptocity, shiptocountry, shiptocontact, - shiptophone, shiptofax, shiptoemail) 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}')|; - $dbh->do($query) || $self->dberror($query); + if ($self->{shipto_id}) { + my $query = qq|UPDATE shipto set + shiptoname = ?, + shiptodepartment_1 = ?, + shiptodepartment_2 = ?, + shiptostreet = ?, + shiptozipcode = ?, + shiptocity = ?, + shiptocountry = ?, + shiptocontact = ?, + shiptophone = ?, + shiptofax = ?, + shiptoemail = ? + WHERE shipto_id = ?|; + do_query($self, $dbh, $query, @values, $self->{shipto_id}); + } else { + my $query = qq|SELECT * FROM shipto + WHERE shiptoname = ? AND + shiptodepartment_1 = ? AND + shiptodepartment_2 = ? AND + shiptostreet = ? AND + shiptozipcode = ? AND + shiptocity = ? AND + shiptocountry = ? AND + shiptocontact = ? 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 (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|; + do_query($self, $dbh, $query, $id, @values, $module); + } + } } -##/LINET + $main::lxdebug->leave_sub(); } @@ -1280,61 +1961,531 @@ 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); + 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; - ($self->{employee_id}, $self->{employee}) = $sth->fetchrow_array; - $self->{employee_id} *= 1; + $main::lxdebug->leave_sub(); +} - $sth->finish; +sub get_employee_data { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; + + Common::check_params(\%params, qw(prefix)); + Common::check_params_x(\%params, qw(id)); + + if (!$params{id}) { + $main::lxdebug->leave_sub(); + return; + } + + my $myconfig = \%main::myconfig; + my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig); + + my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id})); + + if ($login) { + my $user = User->new($login); + map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel); + + $self->{$params{prefix} . '_login'} = $login; + $self->{$params{prefix} . '_name'} ||= $login; + } $main::lxdebug->leave_sub(); } -# get other contact for transaction and form - html/tex -sub get_contact { +sub get_duedate { $main::lxdebug->enter_sub(); - my ($self, $dbh, $id) = @_; + my ($self, $myconfig, $reference_date) = @_; - my $query = qq|SELECT c.* - FROM contacts c - WHERE cp_id=$id|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + my $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date'; + + my $dbh = $self->get_standard_dbh($myconfig); + my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|; + my ($duedate) = selectrow_query($self, $dbh, $query, $self->{payment_id}); + + $main::lxdebug->leave_sub(); + + return $duedate; +} + +sub _get_contacts { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $id, $key) = @_; + + $key = "all_contacts" unless ($key); + + if (!$id) { + $self->{$key} = []; + $main::lxdebug->leave_sub(); + return; + } + + my $query = + 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(cp_name)|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id); + + $main::lxdebug->leave_sub(); +} + +sub _get_projects { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + my ($all, $old_id, $where, @values); + + if (ref($key) eq "HASH") { + my $params = $key; + + $key = "ALL_PROJECTS"; + + foreach my $p (keys(%{$params})) { + if ($p eq "all") { + $all = $params->{$p}; + } elsif ($p eq "old_id") { + $old_id = $params->{$p}; + } elsif ($p eq "key") { + $key = $params->{$p}; + } + } + } + + if (!$all) { + $where = "WHERE active "; + if ($old_id) { + if (ref($old_id) eq "ARRAY") { + my @ids = grep({ $_ } @{$old_id}); + if (@ids) { + $where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") "; + push(@values, @ids); + } + } else { + $where .= " OR (id = ?) "; + push(@values, $old_id); + } + } + } + + my $query = + qq|SELECT id, projectnumber, description, active | . + qq|FROM project | . + $where . + qq|ORDER BY lower(projectnumber)|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values); + + $main::lxdebug->leave_sub(); +} + +sub _get_shipto { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $vc_id, $key) = @_; + + $key = "all_shipto" unless ($key); + + 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); + + } else { + $self->{$key} = []; + } + + $main::lxdebug->leave_sub(); +} + +sub _get_printers { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key = "all_printers" unless ($key); + + my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_charts { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $params) = @_; + my ($key); + + $key = $params->{key}; + $key = "all_charts" unless ($key); + + my $transdate = quote_db_date($params->{transdate}); + + my $query = + qq|SELECT c.id, c.accno, c.description, c.link, tk.taxkey_id, tk.tax_id | . + qq|FROM chart c | . + qq|LEFT JOIN taxkeys tk ON | . + qq|(tk.id = (SELECT id FROM taxkeys | . + qq| WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | . + qq| ORDER BY startdate DESC LIMIT 1)) | . + qq|ORDER BY c.accno|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $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; + } + + my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@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_taxzones { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $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 ($self, $dbh, $key) = @_; + + $key = "all_business_types" unless ($key); + $self->{$key} = + selectall_hashref_query($self, $dbh, qq|SELECT * FROM business|); + + $main::lxdebug->leave_sub(); +} + +sub _get_languages { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $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_dunning_configs { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $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 id|; - $ref = $sth->fetchrow_hashref(NAME_lc); + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_customers { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key, $limit) = @_; + + $key = "all_customers" unless ($key); + my $limit_clause = "LIMIT $limit" if $limit; + + my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|; + + $self->{$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 = ?|; + 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->get_standard_dbh(\%main::myconfig); + my ($sth, $query, $ref); + + my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor"; + my $vc_id = $self->{"${vc}_id"}; + + if ($params{"contacts"}) { + $self->_get_contacts($dbh, $vc_id, $params{"contacts"}); + } + + if ($params{"shipto"}) { + $self->_get_shipto($dbh, $vc_id, $params{"shipto"}); + } + + if ($params{"projects"} || $params{"all_projects"}) { + $self->_get_projects($dbh, $params{"all_projects"} ? + $params{"all_projects"} : $params{"projects"}, + $params{"all_projects"} ? 1 : 0); + } + + if ($params{"printers"}) { + $self->_get_printers($dbh, $params{"printers"}); + } + + if ($params{"languages"}) { + $self->_get_languages($dbh, $params{"languages"}); + } + + if ($params{"charts"}) { + $self->_get_charts($dbh, $params{"charts"}); + } + + if ($params{"taxcharts"}) { + $self->_get_taxcharts($dbh, $params{"taxcharts"}); + } + + if ($params{"taxzones"}) { + $self->_get_taxzones($dbh, $params{"taxzones"}); + } + + if ($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"}); + } + + if ($params{"dunning_configs"}) { + $self->_get_dunning_configs($dbh, $params{"dunning_configs"}); + } + + if($params{"currencies"}) { + $self->_get_currencies($dbh, $params{"currencies"}); + } + + if($params{"customers"}) { + if (ref $params{"customers"} eq 'HASH') { + $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit}); + } else { + $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"}); + } + } - push @{ $self->{$_} }, $ref; + if($params{"payments"}) { + $self->_get_payments($dbh, $params{"payments"}); + } - $sth->finish; - $main::lxdebug->leave_sub(); -} + if($params{"departments"}) { + $self->_get_departments($dbh, $params{"departments"}); + } -# get contacts for id, if no contact return {"","","","",""} -sub get_contacts { - $main::lxdebug->enter_sub(); + if ($params{price_factors}) { + $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey'); + } - my ($self, $dbh, $id) = @_; + if ($params{warehouses}) { + $self->_get_warehouses($dbh, $params{warehouses}); + } - my $query = qq|SELECT c.cp_id, c.cp_cv_id, c.cp_name, c.cp_givenname - FROM contacts c - WHERE cp_cv_id=$id|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); +# if ($params{groups}) { +# $self->_get_groups($dbh, $params{groups}); +# } - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_contacts} }, $ref; - $i++; + if ($params{partsgroup}) { + $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} }); } - if ($i == 0) { - push @{ $self->{all_contacts} }, { { "", "", "", "", "" } }; - } - $sth->finish; $main::lxdebug->leave_sub(); } @@ -1345,49 +2496,45 @@ 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 @@ -1398,28 +2545,19 @@ sub all_vc { my ($self, $myconfig, $table, $module) = @_; my $ref; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->get_standard_dbh($myconfig); + + $table = $table eq "customer" ? "customer" : "vendor"; my $query = qq|SELECT count(*) FROM $table|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - my ($count) = $sth->fetchrow_array; - $sth->finish; + my ($count) = selectrow_query($self, $dbh, $query); # build selection list if ($count < $myconfig->{vclimit}) { - $query = qq|SELECT id, name - 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; - + $query = qq|SELECT id, name, salesman_id + FROM $table WHERE NOT obsolete + ORDER BY name|; + $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query); } # get self @@ -1427,21 +2565,14 @@ 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 = ?)|; + $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} }; + push(@{ $self->{all_employees} }, + { id => $self->{employee_id}, + name => $self->{employee} }); # sort the whole thing @{ $self->{all_employees} } = @@ -1450,26 +2581,76 @@ sub all_vc { if ($module eq 'AR') { # prepare query for departments - $query = qq|SELECT d.id, d.description - FROM department d - WHERE d.role = 'P' - ORDER BY 2|; + $query = qq|SELECT id, description + FROM department + WHERE role = 'P' + ORDER BY description|; } 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); + $self->{all_departments} = selectall_hashref_query($self, $dbh, $query); - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_departments} }, $ref; - } - $sth->finish; + # get languages + $query = qq|SELECT id, description + FROM language + ORDER BY id|; + + $self->{languages} = selectall_hashref_query($self, $dbh, $query); + + # get printer + $query = qq|SELECT printer_description, id + FROM printers + 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|; + + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub language_payment { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + + my $dbh = $self->get_standard_dbh($myconfig); + # get languages + my $query = qq|SELECT id, description + FROM language + ORDER BY id|; + + $self->{languages} = selectall_hashref_query($self, $dbh, $query); + + # get printer + $query = qq|SELECT printer_description, id + FROM printers + 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|; + + $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query); + + # get buchungsgruppen + $query = qq|SELECT id, description + FROM buchungsgruppen|; + + $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query); - $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -1479,28 +2660,20 @@ sub all_departments { my ($self, $myconfig, $table) = @_; - my $dbh = $self->dbconnect($myconfig); - my $where = "1 = 1"; + my $dbh = $self->get_standard_dbh($myconfig); + my $where; - if (defined $table) { - if ($table eq 'customer') { - $where = " d.role = 'P'"; - } + if ($table eq 'customer') { + $where = "WHERE 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); - - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_departments} }, $ref; - } - $sth->finish; + my $query = qq|SELECT id, description + FROM department + $where + 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(); } @@ -1508,165 +2681,217 @@ 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 $dbh = $self->dbconnect($myconfig); + my ($query, $sth, $ref); + my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig); my %xkeyref = (); - # now get the account numbers - $query = - qq|SELECT c.accno, SUBSTRING(c.description,1,50) as description, c.link, c.taxkey_id - FROM chart c - WHERE c.link LIKE '%$module%' - ORDER BY c.accno|; + if (!$self->{id}) { - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + my $transdate = "current_date"; + if ($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 ?) 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|; + + $sth = $dbh->prepare($query); - $self->{accounts} = ""; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + do_statement($self, $sth, $query, '%' . $module . '%'); - foreach my $key (split /:/, $ref->{link}) { - if ($key =~ /$module/) { + $self->{accounts} = ""; + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { - # cross reference for keys - $xkeyref{ $ref->{accno} } = $key; + foreach my $key (split(/:/, $ref->{link})) { + if ($key =~ /\Q$module\E/) { - push @{ $self->{"${module}_links"}{$key} }, - { accno => $ref->{accno}, - description => $ref->{description}, - taxkey => $ref->{taxkey_id} }; + # cross reference for keys + $xkeyref{ $ref->{accno} } = $key; - $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; + 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/; + } } } } - $sth->finish; - if (($module eq "AP") || ($module eq "AR")) { + # get taxkeys and description + $query = qq|SELECT id, taxkey, taxdescription FROM tax|; + $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|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - $form->{TAX} = (); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{TAX} }, $ref; - } - $sth->finish; + $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 - 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}|; + $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, + 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}; + } + + my $transdate = "current_date"; + if ($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.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); - $sth->execute || $self->dberror($query); + do_statement($self, $sth, $query, "%$module%"); - $ref = $sth->fetchrow_hashref(NAME_lc); - foreach $key (keys %$ref) { - $self->{$key} = $ref->{$key}; + $self->{accounts} = ""; + while ($ref = $sth->fetchrow_hashref("NAME_lc")) { + + foreach my $key (split(/:/, $ref->{link})) { + 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/; + } + } } - $sth->finish; + # 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 - 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 (a.taxkey = t.taxkey) - WHERE a.trans_id = $self->{id} - AND a.fx_transaction = '0' - ORDER BY a.transdate|; + $query = + qq|SELECT + c.accno, c.description, + a.source, a.amount, a.memo, a.transdate, 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.oid, a.transdate|; $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($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++; + } + if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) { + $ref->{amount} *= -1; + } + $ref->{index} = $index; push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref; } - $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); - $sth->execute || $self->dberror($query); - $ref = $sth->fetchrow_hashref(NAME_lc); - map { $self->{$_} = $ref->{$_} } keys %$ref; $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|; + $ref = selectfirst_hashref_query($self, $dbh, $query); + map { $self->{$_} = $ref->{$_} } keys %$ref; } 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); - $sth->execute || $self->dberror($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}); } 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); } } - $dbh->disconnect; - $main::lxdebug->leave_sub(); } @@ -1675,43 +2900,52 @@ sub lastname_used { my ($self, $dbh, $myconfig, $table, $module) = @_; - my $arap = ($table eq 'customer') ? "ar" : "ap"; - my $where = "1 = 1"; + my ($arap, $where); - if ($self->{type} =~ /_order/) { + $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, + "current_date + ct.terms" => "duedate", + ); + + if ($self->{type} =~ /delivery_order/) { + $arap = 'delivery_orders'; + delete $column_map{"a.curr"}; + + } elsif ($self->{type} =~ /_order/) { $arap = 'oe'; $where = "quotation = '0'"; - } - if ($self->{type} =~ /_quotation/) { + + } elsif ($self->{type} =~ /_quotation/) { $arap = 'oe'; $where = "quotation = '1'"; - } - my $query = qq|SELECT id FROM $arap - WHERE id IN (SELECT MAX(id) FROM $arap - WHERE $where - AND ${table}_id > 0)|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + } elsif ($table eq 'customer') { + $arap = 'ar'; - my ($trans_id) = $sth->fetchrow_array; - $sth->finish; + } else { + $arap = 'ap'; - $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); + } - ($self->{$table}, $self->{currency}, $self->{"${table}_id"}, - $self->{duedate}, $self->{department_id}, $self->{department}) - = $sth->fetchrow_array; - $sth->finish; + $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 $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); + + map { $self->{$_} = $ref->{$_} } values %column_map; $main::lxdebug->leave_sub(); } @@ -1721,29 +2955,20 @@ sub current_date { my ($self, $myconfig, $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(); @@ -1773,15 +2998,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}; } @@ -1803,47 +3027,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; @@ -1862,10 +3084,9 @@ sub save_status { my $formnames = $self->{printed}; my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status - WHERE formname = '$self->{formname}' - AND trans_id = $self->{id}|; - $dbh->do($query) || $self->dberror($query); + $query = qq|DELETE FROM status + 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 @@ -1874,17 +3095,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//; } } @@ -1898,124 +3117,201 @@ 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(); } -sub update_defaults { +#--- 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('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, $myconfig, $fld) = @_; + my $self = shift(); + my $dbh = shift(); - my $dbh = $self->dbconnect_noauto($myconfig); - my $query = qq|SELECT $fld FROM defaults FOR UPDATE|; - my $sth = $dbh->prepare($query); - - $sth->execute || $self->dberror($query); - my ($var) = $sth->fetchrow_array; - $sth->finish; + if(!exists $self->{employee_id}) { + &get_employee($self, $dbh); + } - $var++; + 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); - $query = qq|UPDATE defaults - SET $fld = '$var'|; - $dbh->do($query) || $form->dberror($query); + $main::lxdebug->leave_sub(); +} - $dbh->commit; - $dbh->disconnect; +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 $var; + return 0; } -sub update_business { +sub update_defaults { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $business_id) = @_; + my ($self, $myconfig, $fld, $provided_dbh) = @_; - my $dbh = $self->dbconnect_noauto($myconfig); - my $query = - qq|SELECT customernumberinit FROM business WHERE id=$business_id FOR UPDATE|; - my $sth = $dbh->prepare($query); + my $dbh; + if ($provided_dbh) { + $dbh = $provided_dbh; + } else { + $dbh = $self->dbconnect_noauto($myconfig); + } + my $query = qq|SELECT $fld FROM defaults FOR UPDATE|; + my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); my ($var) = $sth->fetchrow_array; $sth->finish; - if ($var ne "") { - $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) || $form->dberror($query); - $dbh->commit; - $dbh->disconnect; + $query = qq|UPDATE defaults SET $fld = ?|; + do_query($self, $dbh, $query, $var); + + if (!$provided_dbh) { + $dbh->commit; + $dbh->disconnect; + } $main::lxdebug->leave_sub(); return $var; } -sub get_salesman { +sub update_business { $main::lxdebug->enter_sub(); - my ($self, $myconfig, $salesman) = @_; + my ($self, $myconfig, $business_id, $provided_dbh) = @_; - my $dbh = $self->dbconnect($myconfig); + my $dbh; + if ($provided_dbh) { + $dbh = $provided_dbh; + } else { + $dbh = $self->dbconnect_noauto($myconfig); + } my $query = - qq|SELECT id, name FROM customer WHERE (customernumber ilike '%$salesman%' OR name ilike '%$salesman%') AND business_id in (SELECT id from business WHERE salesman)|; - my $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + qq|SELECT customernumberinit FROM business + WHERE id = ? FOR UPDATE|; + my ($var) = selectrow_query($self, $dbh, $query, $business_id); - my $i = 0; - while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - push(@{ $self->{salesman_list} }, $ref); - $i++; + 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'; } - $dbh->commit; + + $query = qq|UPDATE business + SET customernumberinit = ? + WHERE id = ?|; + do_query($self, $dbh, $query, $var, $business_id); + + if (!$provided_dbh) { + $dbh->commit; + $dbh->disconnect; + } + $main::lxdebug->leave_sub(); - return $i; + return $var; } 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 @@ -2024,190 +3320,99 @@ 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(); } -package Locale; - -sub new { +sub get_pricegroup { $main::lxdebug->enter_sub(); - my ($type, $country, $NLS_file) = @_; - my $self = {}; - - %self = (); - if ($country && -d "locale/$country") { - $self->{countrycode} = $country; - eval { require "locale/$country/$NLS_file"; }; - } - - $self->{NLS_file} = $NLS_file; - - push @{ $self->{LONG_MONTH} }, - ("January", "February", "March", "April", - "May ", "June", "July", "August", - "September", "October", "November", "December"); - push @{ $self->{SHORT_MONTH} }, - (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); - - $main::lxdebug->leave_sub(); - - bless $self, $type; -} - -sub text { - my ($self, $text) = @_; + my ($self, $myconfig, $p) = @_; - return (exists $self{texts}{$text}) ? $self{texts}{$text} : $text; -} + my $dbh = $self->get_standard_dbh($myconfig); -sub findsub { - $main::lxdebug->enter_sub(); + my $query = qq|SELECT p.id, p.pricegroup + FROM pricegroup p|; - my ($self, $text) = @_; + $query .= qq| ORDER BY pricegroup|; - if (exists $self{subs}{$text}) { - $text = $self{subs}{$text}; - } else { - if ($self->{countrycode} && $self->{NLS_file}) { - Form->error( - "$text not defined in locale/$self->{countrycode}/$self->{NLS_file}"); - } + if ($p->{all}) { + $query = qq|SELECT id, pricegroup FROM pricegroup + ORDER BY pricegroup|; } - $main::lxdebug->leave_sub(); + $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query); - return $text; + $main::lxdebug->leave_sub(); } -sub date { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $date, $longformat) = @_; +sub all_years { +# usage $form->all_years($myconfig, [$dbh]) +# return list of all years where bookings found +# (@all_years) - my $longdate = ""; - my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH'; + $main::lxdebug->enter_sub(); - if ($date) { + my ($self, $myconfig, $dbh) = @_; - # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 1, 1); + $dbh ||= $self->get_standard_dbh($myconfig); - if ($date =~ /\D/) { - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } - if ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } - if ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } - } else { - $date = substr($date, 2); - ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); - } + # 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); - $dd *= 1; - $mm--; - $yy = ($yy < 70) ? $yy + 2000 : $yy; - $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + if ($myconfig->{dateformat} =~ /^yy/) { + ($startdate) = split /\W/, $startdate; + ($enddate) = split /\W/, $enddate; + } else { + (@_) = split /\W/, $startdate; + $startdate = $_[2]; + (@_) = split /\W/, $enddate; + $enddate = $_[2]; + } - if ($myconfig->{dateformat} =~ /^dd/) { - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$dd$spc$mm$spc$yy"; - } else { - $longdate = "$dd"; - $longdate .= ($spc eq '.') ? ". " : " "; - $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; - } - } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") { - - # Use German syntax with the ISO date style "yyyy-mm-dd" because - # Lx-Office is mainly used in Germany or German speaking countries. - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$yy-$mm-$dd"; - } else { - $longdate = "$dd. "; - $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; - } - } else { - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$mm$spc$dd$spc$yy"; - } else { - $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy"; - } - } + my @all_years; + $startdate = substr($startdate,0,4); + $enddate = substr($enddate,0,4); + while ($enddate >= $startdate) { + push @all_years, $enddate--; } - $main::lxdebug->leave_sub(); + return @all_years; - return $longdate; + $main::lxdebug->leave_sub(); } -sub parse_date { +sub backup_vars { $main::lxdebug->enter_sub(); + my $self = shift; + my @vars = @_; - my ($self, $myconfig, $date, $longformat) = @_; + map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars; - unless ($date) { - $main::lxdebug->leave_sub(); - return (); - } + $main::lxdebug->leave_sub(); +} - # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 1, 1); +sub restore_vars { + $main::lxdebug->enter_sub(); - if ($date =~ /\D/) { - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } elsif ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } elsif ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } - } else { - $date = substr($date, 2); - ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); - } + my $self = shift; + my @vars = @_; - $dd *= 1; - $mm *= 1; - $yy = ($yy < 70) ? $yy + 2000 : $yy; - $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars; $main::lxdebug->leave_sub(); - return ($yy, $mm, $dd); } 1;