X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=7636b16595b6ed42ca5efb4a4ec3191ec59602a3;hb=bb374138781bbf3a368d104445aee887494aa381;hp=5c2b5737916ad1224feb5a24f719afdb4435b26a;hpb=4dbb09950c9f5596646537c12d991c99086fe7c1;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 5c2b57379..7636b1659 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 @@ -36,55 +36,69 @@ #====================================================================== package Form; +use Data::Dumper; + +use Cwd; +use HTML::Template; +use SL::Template; +use CGI::Ajax; +use SL::DBUtils; +use SL::Menu; +use CGI; sub _input_to_hash { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my $input = $_[0]; - my %in = (); + my %in = (); my @pairs = split(/&/, $input); foreach (@pairs) { - my ($name, $value) = split(/=/,$_,2); + my ($name, $value) = split(/=/, $_, 2); $in{$name} = unescape(undef, $value); } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return %in; } sub _request_to_hash { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($input) = @_; - my ($i, $loc, $key, $val); - my (%ATTACH, $f, $header, $header_body, $len, $buf); - my ($boundary, @list, $size, $body, $x, $blah, $name); + 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=(.+)$/)) { + if ($ENV{'CONTENT_TYPE'} + && ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/)) { $boundary = quotemeta('--' . $1); - @list = split(/$boundary/, $input); + @list = split(/$boundary/, $input); + # For some reason there are always 2 extra, that are empty - $size = @list -2 ; + $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 = $'; #' $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=\"(.+)\"/; @@ -93,19 +107,19 @@ sub _request_to_hash { $ATTACH{'FILE_NAME'} =~ s/\s//g; $ATTACH{'FILE_CONTENT'} = $body; - for($i = $x; $list[$i]; $i++) { + for ($i = $x; $list[$i]; $i++) { $list[$i] =~ s/^.+name=$//; $list[$i] =~ /\"(\w+)\"/; - $ATTACH{$1} = $'; #' + $ATTACH{$1} = $'; #' } } } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return %ATTACH; - } else { - $main::lxdebug->leave_sub(); + } else { + $main::lxdebug->leave_sub(2); return _input_to_hash($input); } } @@ -130,20 +144,16 @@ sub new { my %parameters = _request_to_hash($_); map({ $self->{$_} = $parameters{$_}; } keys(%parameters)); - $self->{menubar} = 1 if $self->{path} =~ /lynx/i; - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|#)/_/g; + $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.1.2"; - $self->{dbversion} = "2.1.2"; + $self->{version} = "2.4.2"; $main::lxdebug->leave_sub(); bless $self, $type; } - sub debug { $main::lxdebug->enter_sub(); @@ -156,9 +166,8 @@ sub debug { $main::lxdebug->leave_sub(); } - sub escape { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $str, $beenthere) = @_; @@ -169,14 +178,13 @@ sub escape { $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) = @_; @@ -185,34 +193,79 @@ 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 quote { + my ($self, $str) = @_; -sub error { - $main::lxdebug->enter_sub(); + if ($str && !ref($str)) { + $str =~ s/\"/"/g; + } - my ($self, $msg) = @_; + $str; - if ($ENV{HTTP_USER_AGENT}) { - $msg =~ s/\n/
/g; +} - $self->header; +sub unquote { + my ($self, $str) = @_; - print qq| - + if ($str && !ref($str)) { + $str =~ s/"/\"/g; + } -

Error!

+ $str; -

$msg +} - - - |; +sub quote_html { + $main::lxdebug->enter_sub(2); + + my ($self, $str) = @_; - die "Error: $msg\n"; + my %replace = + ('order' => ['"', '<', '>'], + '<' => '<', + '>' => '>', + '"' => '"', + ); + + map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + $main::lxdebug->leave_sub(2); + + return $str; +} + +sub hide_form { + my $self = shift; + + if (@_) { + for (@_) { + print qq|\n|; + } + } else { + delete $self->{header}; + for (sort keys %$self) { + print qq|\n|; + } + } + +} + +sub error { + $main::lxdebug->enter_sub(); + + my ($self, $msg) = @_; + if ($ENV{HTTP_USER_AGENT}) { + $msg =~ s/\n/
/g; + $self->show_generic_error($msg); } else { @@ -226,7 +279,6 @@ sub error { $main::lxdebug->leave_sub(); } - sub info { $main::lxdebug->enter_sub(); @@ -258,9 +310,6 @@ sub info { $main::lxdebug->leave_sub(); } - - - sub numtextrows { $main::lxdebug->enter_sub(); @@ -268,7 +317,7 @@ sub numtextrows { my $rows = 0; - map { $rows += int (((length) - 2)/$cols) + 1 } split /\r/, $str; + map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; $maxrows = $rows unless defined $maxrows; @@ -277,18 +326,16 @@ sub numtextrows { return ($rows > $maxrows) ? $maxrows : $rows; } - sub dberror { $main::lxdebug->enter_sub(); my ($self, $msg) = @_; - $self->error("$msg\n".$DBI::errstr); + $self->error("$msg\n" . $DBI::errstr); $main::lxdebug->leave_sub(); } - sub isblank { $main::lxdebug->enter_sub(); @@ -300,11 +347,10 @@ sub isblank { $main::lxdebug->leave_sub(); } - sub header { $main::lxdebug->enter_sub(); - my ($self) = @_; + my ($self, $extra_code) = @_; if ($self->{header}) { $main::lxdebug->leave_sub(); @@ -316,24 +362,29 @@ sub header { if ($ENV{HTTP_USER_AGENT}) { if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = qq| + $stylesheet = + qq| |; } + $self->{favicon} = "favicon.ico" unless $self->{favicon}; + if ($self->{favicon} && (-f "$self->{favicon}")) { - $favicon = qq| + $favicon = + qq| |; } if ($self->{charset}) { - $charset = qq| + $charset = + qq| |; } - if ($self->{landscape}) { + if ($self->{landscape}) { $pagelayout = qq||; - } + } if ($self->{fokus}) { $fokus = qq||; } - + #Set Calendar - $jsscript = ""; - if ($self->{jsscript} == 1){ + my $jsscript = ""; + if ($self->{jsscript} == 1) { $jsscript = qq| -  -  - |; - } - - $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; + + + $self->{javascript} + |; + } + $self->{titlebar} = + ($self->{title}) + ? "$self->{title} - $self->{titlebar}" + : $self->{titlebar}; + my $ajax = ""; + foreach $item (@ { $self->{AJAX} }) { + $ajax .= $item->show_javascript(); + } print qq|Content-Type: text/html + $self->{titlebar} $stylesheet @@ -365,7 +424,23 @@ function fokus(){document.$self->{fokus}.focus();} $favicon $charset $jsscript + $ajax $fokus + + + + + + + $extra_code |; @@ -375,80 +450,168 @@ function fokus(){document.$self->{fokus}.focus();} $main::lxdebug->leave_sub(); } -# write Trigger JavaScript-Code ($qty = 1 - only one Trigger) -sub write_trigger { +sub parse_html_template { $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"; - } - } - } - } + my ($self, $file, $additional_params) = @_; + my $language; + + if (!defined($main::myconfig) || !defined($main::myconfig{"countrycode"})) { + $language = $main::language; + } else { + $language = $main::myconfig{"countrycode"}; + } + + if (-f "templates/webpages/${file}_${language}.html") { + if ((-f ".developer") && + (-f "templates/webpages/${file}_master.html") && + ((stat("templates/webpages/${file}_master.html"))[9] > + (stat("templates/webpages/${file}_${language}.html"))[9])) { + my $info = "Developper information: templates/webpages/${file}_master.html is newer than the localized version.\n" . + "Please re-run 'locales.pl' in 'locale/${language}'."; + print(qq|

$info
|); + die($info); } + + $file = "templates/webpages/${file}_${language}.html"; + } elsif (-f "templates/webpages/${file}.html") { + $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); } - - $trigger_1 = qq| + + my $template = HTML::Template->new("filename" => $file, + "die_on_bad_params" => 0, + "strict" => 0, + "case_sensitive" => 1, + "loop_context_vars" => 1, + "global_vars" => 1); + + $additional_params = {} unless ($additional_params); + if ($self->{"DEBUG"}) { + $additional_params->{"DEBUG"} = $self->{"DEBUG"}; + } + + if ($additional_params->{"DEBUG"}) { + $additional_params->{"DEBUG"} = + "
DEBUG INFORMATION:
" . $additional_params->{"DEBUG"} . "
"; + } + + 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; + } + + $additional_params->{"conf_jscalendar"} = $main::jscalendar; + $additional_params->{"conf_lizenzen"} = $main::lizenzen; + $additional_params->{"conf_latex_templates"} = $main::latex; + $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates; + + my @additional_param_names = keys(%{$additional_params}); + foreach my $key ($template->param()) { + my $param = $self->{$key}; + $param = $additional_params->{$key} if (grep(/^${key}$/, @additional_param_names)); + $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY")); + $template->param($key => $param); + } + + my $output = $template->output(); + + $main::lxdebug->leave_sub(); + + return $output; +} + +sub show_generic_error { + my ($self, $error, $title, $action) = @_; + + my $add_params = {}; + $add_params->{"title"} = $title if ($title); + $self->{"label_error"} = $error; + + my @vars; + if ($action) { + map({ delete($self->{$_}); } qw(action)); + map({ push(@vars, { "name" => $_, "value" => $self->{$_} }) + if (!ref($self->{$_})); } + keys(%{$self})); + $add_params->{"SHOW_BUTTON"} = 1; + $add_params->{"BUTTON_LABEL"} = $action; + } + $add_params->{"VARIABLES"} = \@vars; + + $self->header(); + print($self->parse_html_template("generic/error", $add_params)); + + die("Error: $error\n"); +} + +sub show_generic_information { + my ($self, $error, $title) = @_; + + my $add_params = {}; + $add_params->{"title"} = $title if ($title); + $self->{"label_information"} = $error; + + $self->header(); + print($self->parse_html_template("generic/information", $add_params)); + + die("Information: $error\n"); +} + +# 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 = shift; + my $myconfig = shift; + my $qty = shift; + + # 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  : "$inputField_1", -    ifFormat    :"$ifFormat", -    align    : "$align_1",      -    button      : "$button_1" -  } -  ); + { + inputField : "| . (shift) . qq|", + ifFormat :"$ifFormat", + align : "| . (shift) . qq|", + button : "| . (shift) . qq|" + } + ); |; - - if ($qty ==2){ - $trigger_2 = qq| - Calendar.setup( - { -     inputField  : "$inputField_2", -     ifFormat    :"$ifFormat", -    align    : "$align_2",      -    button      : "$button_2" -  } -  ); - |; - }; - $jsscript= qq| + } + my $jsscript = qq| |; $main::lxdebug->leave_sub(); return $jsscript; -}#end sub write_trigger +} #end sub write_trigger sub redirect { $main::lxdebug->enter_sub(); @@ -458,7 +621,7 @@ sub redirect { if ($self->{callback}) { ($script, $argv) = split(/\?/, $self->{callback}); - exec ("perl", "$script", $argv); + exec("perl", "$script", $argv); } else { @@ -479,145 +642,141 @@ sub sort_columns { return @columns; } - - +# sub format_amount { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount, $places, $dash) = @_; - - if ($places =~ /\d/) { - $amount = $self->round_amount($amount, $places); + + if ($amount eq "") { + $amount = 0; } + my $neg = ($amount =~ s/-//); - # is the amount negative - my $negative = ($amount < 0); + if (defined($places) && ($places ne '')) { + if ($places < 0) { + $amount *= 1; + $places *= -1; - if ($amount != 0) { - if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) { - my ($whole, $dec) = split /\./, "$amount"; - $whole =~ s/-//; - $amount = join '', reverse split //, $whole; + my ($actual_places) = ($amount =~ /\.(\d+)/); + $actual_places = length($actual_places); + $places = $actual_places > $places ? $actual_places : $places; + } - if ($myconfig->{numberformat} eq '1,000.00') { - $amount =~ s/\d{3,}?/$&,/g; - $amount =~ s/,$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" if ($dec ne ""); - } + $amount = $self->round_amount($amount, $places); + } - 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 @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars + my @p = split(/\./, $amount); # split amount at decimal point - if ($myconfig->{numberformat} eq '1000,00') { - $amount = "$whole"; - $amount .= ",$dec" if ($dec ne ""); - } + $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters - 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"; - } - } + $amount = $p[0]; + $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); - $main::lxdebug->leave_sub(); + $amount = do { + ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : + ($dash =~ /DRCR/) ? ($neg ? "$amount DR" : "$amount CR" ) : + ($neg ? "-$amount" : "$amount" ) ; + }; + + $main::lxdebug->leave_sub(2); return $amount; } - - +# sub parse_amount { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount) = @_; - - if (!(substr($amount, -3,1) eq ".")) { - if (($myconfig->{numberformat} eq '1.000,00') || - ($myconfig->{numberformat} eq '1000,00')) { - $amount =~ s/\.//g; - $amount =~ s/,/\./; - } - $amount =~ s/,//g; + if ( ($myconfig->{numberformat} eq '1.000,00') + || ($myconfig->{numberformat} eq '1000,00')) { + $amount =~ s/\.//g; + $amount =~ s/,/\./; } - $main::lxdebug->leave_sub(); + if ($myconfig->{numberformat} eq "1'000.00") { + $amount =~ s/\'//g; + } + + $amount =~ s/,//g; + + $main::lxdebug->leave_sub(2); return ($amount * 1); } - sub round_amount { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $amount, $places) = @_; - my $rc; + my $round_amount; -# $places = 3 if $places == 2; + # Rounding like "Kaufmannsrunden" + # Descr. http://de.wikipedia.org/wiki/Rundung + # Inspired by + # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html + # Solves Bug: 189 + # Udo Spallek + $amount = $amount * (10**($places)); + $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places)); - if (($places * 1) >= 0) { - # 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); - } + $main::lxdebug->leave_sub(2); - $main::lxdebug->leave_sub(); + return $round_amount; - return $rc; } sub parse_template { $main::lxdebug->enter_sub(); my ($self, $myconfig, $userspath) = @_; + my $template; + + $self->{"cwd"} = getcwd(); + $self->{"tmpdir"} = $self->{cwd} . "/${userspath}"; + + if ($self->{"format"} =~ /(opendocument|oasis)/i) { + $template = OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { + $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; + $template = LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif (($self->{"format"} =~ /html/i) || + (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) { + $template = HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif (($self->{"format"} =~ /xml/i) || + (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( $self->{"format"} =~ /elsterwinston/i ) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } elsif ( $self->{"format"} =~ /elstertaxbird/i ) { + $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath); + } 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'}"); + } - # { 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; - # } Moritz Bunkus - - # Make sure that all *notes* (intnotes, partnotes_*, notes etc) are converted to markup correctly. - $self->format_string(grep(/notes/, keys(%{$self}))); # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be. - $self->{"notes"} = $self->{$self->{"formname"} . "notes"}; - - map({ $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature)); + $self->{"notes"} = $self->{ $self->{"formname"} . "notes" }; - open(IN, "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!"); - - @_ = ; - close(IN); + map({ $self->{"employee_${_}"} = $myconfig->{$_}; } + qw(email tel fax name signature company address businessnumber + co_ustid taxnumber duns)); + map({ $self->{"employee_${_}"} =~ s/\\n/\n/g; } + qw(company address signature)); + map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature)); $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); # OUT is used for the media, screen, printer, email # for postscript we store a copy in a temporary file my $fileid = time; - $self->{tmpfile} = "$userspath/${fileid}.$self->{IN}"; - if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + $self->{tmpfile} = "$userspath/${fileid}.$self->{IN}" if ( $self->{tmpfile} eq '' ); + if ($template->uses_temp_file() || $self->{media} eq 'email') { $out = $self->{OUT}; $self->{OUT} = ">$self->{tmpfile}"; } @@ -629,307 +788,112 @@ sub parse_template { $self->header; } - # Do we have to run LaTeX two times? This is needed if - # the template contains page references. - $two_passes = 0; - - # first we generate a tmpfile - # read file and replace <%variable%> - while ($_ = shift) { - - $par = ""; - $var = $_; - - $two_passes = 1 if (/\\pageref/); - - # { 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; - - while ($_ = shift) { - last if (/\s*<%end pagebreak%>/); - $pagebreak .= $_; - } - } - # } Moritz Bunkus - - - if (/\s*<%foreach /) { - - # this one we need for the count - chomp $var; - $var =~ s/\s*<%foreach (.+?)%>/$1/; - while ($_ = shift) { - last if (/\s*<%end /); - - # store line in $par - $par .= $_; - } - - # 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 - - - # don't parse par, we need it for each line - $_ = $par; - s/<%(.+?)%>/$self->{$1}[$i]/mg; - print OUT; - } - next; - } - - # if not comes before if! - if (/\s*<%if not /) { - # check if it is not set and display - chop; - s/\s*<%if not (.+?)%>/$1/; - - unless ($self->{$_}) { - while ($_ = shift) { - last if (/\s*<%end /); - - # store line in $par - $par .= $_; - } - - $_ = $par; - - } else { - while ($_ = shift) { - last if (/\s*<%end /); - } - next; - } - } - - if (/\s*<%if /) { - # check if it is set and display - chop; - s/\s*<%if (.+?)%>/$1/; - - if ($self->{$_}) { - while ($_ = shift) { - last if (/\s*<%end /); - - # store line in $par - $par .= $_; - } - - $_ = $par; - - } else { - while ($_ = shift) { - last if (/\s*<%end /); - } - next; - } - } - - # check for <%include filename%> - if (/\s*<%include /) { - - # get the filename - chomp $var; - $var =~ s/\s*<%include (.+?)%>/$1/; - - # mangle filename - $var =~ s/(\/|\.\.)//g; - - # prevent the infinite loop! - next if ($self->{"$var"}); - - open(INC, "$self->{templates}/$var") or $self->error($self->cleanup."$self->{templates}/$var : $!"); - unshift(@_, ); - close(INC); - - $self->{"$var"} = 1; - - next; - } - - s/<%(.+?)%>/$self->{$1}/g; - print OUT; + if (!$template->parse(*OUT)) { + $self->cleanup(); + $self->error("$self->{IN} : " . $template->get_error()); } close(OUT); - - # { Moritz Bunkus - # Convert the tex file to postscript - if ($self->{format} =~ /(postscript|pdf)/) { - - use Cwd; - $self->{cwd} = cwd(); - $self->{tmpdir} = "$self->{cwd}/$userspath"; - - chdir("$userspath") or $self->error($self->cleanup."chdir : $!"); - - $self->{tmpfile} =~ s/$userspath\///g; - - 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 ($?); - } - - $self->{tmpfile} =~ s/tex$/dvi/; - - 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/; - } - - } - - if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + if ($template->uses_temp_file() || $self->{media} eq 'email') { if ($self->{media} eq 'email') { - + use SL::Mailer; my $mail = new Mailer; - - map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format charset); - $mail->{to} = qq|$self->{email}|; - $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + + map { $mail->{$_} = $self->{$_} } + qw(cc bcc subject message version format charset); + $mail->{to} = qq|$self->{email}|; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; $mail->{fileid} = "$fileid."; + $myconfig->{signature} =~ s/\\r\\n/\\n/g; # if we send html or plain text inline if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) { - $mail->{contenttype} = "text/html"; + $mail->{contenttype} = "text/html"; - $mail->{message} =~ s/\r\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} : $!"); - while () { - $mail->{message} .= $_; - } + $mail->{message} =~ s/\r\n/
\n/g; + $myconfig->{signature} =~ s/\\n/
\n/g; + $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; - close(IN); + open(IN, $self->{tmpfile}) + or $self->error($self->cleanup . "$self->{tmpfile} : $!"); + while () { + $mail->{message} .= $_; + } + + close(IN); } else { - - @{ $mail->{attachments} } = ($self->{tmpfile}); - $myconfig->{signature} =~ s/\\n/\r\n/g; - $mail->{message} .= "\r\n--\r\n$myconfig->{signature}"; + if (!$self->{"do_not_attach"}) { + @{ $mail->{attachments} } = + ({ "filename" => $self->{"tmpfile"}, + "name" => $self->{"attachment_filename"} ? + $self->{"attachment_filename"} : $self->{"tmpfile"} }); + } + + $mail->{message} =~ s/\r\n/\n/g; + $myconfig->{signature} =~ s/\\n/\n/g; + $mail->{message} .= "\n-- \n$myconfig->{signature}"; } - + my $err = $mail->send($out); - $self->error($self->cleanup."$err") if ($err); - + $self->error($self->cleanup . "$err") if ($err); + } else { - + $self->{OUT} = $out; - + my $numbytes = (-s $self->{tmpfile}); - open(IN, $self->{tmpfile}) or $self->error($self->cleanup."$self->{tmpfile} : $!"); + open(IN, $self->{tmpfile}) + or $self->error($self->cleanup . "$self->{tmpfile} : $!"); $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 { - - # launch application - print qq|Content-Type: application/$self->{format} -Content-Disposition: attachment; filename="$self->{tmpfile}" + if ($self->{OUT}) { + open(OUT, $self->{OUT}) + or $self->error($self->cleanup . "$self->{OUT} : $!"); + } else { + $self->{attachment_filename} = $self->{tmpfile} if ($self->{attachment_filename} eq ''); + # launch application + print qq|Content-Type: | . $template->get_mime_type() . qq| +Content-Disposition: attachment; filename="$self->{attachment_filename}" Content-Length: $numbytes |; - open(OUT, ">-") or $self->error($self->cleanup."$!: STDOUT"); + open(OUT, ">-") or $self->error($self->cleanup . "$!: STDOUT"); - } - - while () { - print OUT $_; - } - - close(OUT); - - seek IN, 0, 0; + } + + while () { + print OUT $_; + } + + close(OUT); + + seek IN, 0, 0; } close(IN); } - $self->cleanup; - } + $self->cleanup; + chdir("$self->{cwd}"); $main::lxdebug->leave_sub(); } - sub cleanup { $main::lxdebug->enter_sub(); @@ -945,6 +909,7 @@ sub cleanup { } if ($self->{tmpfile}) { + $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; my $tmpfile = $self->{tmpfile}; @@ -958,48 +923,6 @@ 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(); @@ -1024,7 +947,7 @@ sub datetonum { $dd = "0$dd" if ($dd < 10); $mm = "0$mm" if ($mm < 10); - + $date = "$yy$mm$dd"; } @@ -1033,8 +956,6 @@ sub datetonum { return $date; } - - # Database routines used throughout sub dbconnect { @@ -1043,7 +964,10 @@ sub dbconnect { my ($self, $myconfig) = @_; # connect to database - my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}) or $self->dberror; + my $dbh = + DBI->connect($myconfig->{dbconnect}, + $myconfig->{dbuser}, $myconfig->{dbpasswd}) + or $self->dberror; # set db options if ($myconfig->{dboptions}) { @@ -1055,14 +979,16 @@ sub dbconnect { return $dbh; } - sub dbconnect_noauto { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; # connect to database - $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, {AutoCommit => 0}) or $self->dberror; + $dbh = + DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, + $myconfig->{dbpasswd}, { AutoCommit => 0 }) + or $self->dberror; # set db options if ($myconfig->{dboptions}) { @@ -1074,7 +1000,6 @@ sub dbconnect_noauto { return $dbh; } - sub update_balance { $main::lxdebug->enter_sub(); @@ -1082,15 +1007,17 @@ sub update_balance { # if we have a value, go do it if ($value != 0) { + # retrieve balance from table my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); 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); @@ -1098,8 +1025,6 @@ sub update_balance { $main::lxdebug->leave_sub(); } - - sub update_exchangerate { $main::lxdebug->enter_sub(); @@ -1117,7 +1042,7 @@ sub update_exchangerate { FOR UPDATE|; my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); - + my $set; if ($buy != 0 && $sell != 0) { $set = "buy = $buy, sell = $sell"; @@ -1126,7 +1051,7 @@ sub update_exchangerate { } elsif ($sell != 0) { $set = "sell = $sell"; } - + if ($sth->fetchrow_array) { $query = qq|UPDATE exchangerate SET $set @@ -1138,11 +1063,10 @@ sub update_exchangerate { } $sth->finish; $dbh->do($query) || $self->dberror($query); - + $main::lxdebug->leave_sub(); } - sub save_exchangerate { $main::lxdebug->enter_sub(); @@ -1151,22 +1075,26 @@ sub save_exchangerate { my $dbh = $self->dbconnect($myconfig); my ($buy, $sell) = (0, 0); - $buy = $rate if $fld eq 'buy'; + $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(); } - sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + unless ($transdate) { + $main::lxdebug->leave_sub(); + return 1; + } + my $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = '$curr' AND e.transdate = '$transdate'|; @@ -1176,11 +1104,106 @@ sub get_exchangerate { my ($exchangerate) = $sth->fetchrow_array; $sth->finish; + if (!$exchangerate) { + $exchangerate = 1; + } + $main::lxdebug->leave_sub(); return $exchangerate; } +sub set_payment_options { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $transdate) = @_; + + if ($self->{payment_id}) { + + my $dbh = $self->dbconnect($myconfig); + + my $query = + qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, | . + qq|p.description_long | . + qq|FROM payment_terms p | . + qq|WHERE p.id = ?|; + + ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, + $self->{payment_terms}) = + selectrow_query($self, $dbh, $query, $self->{payment_id}); + + if ($transdate eq "") { + if ($self->{invdate}) { + $transdate = $self->{invdate}; + } else { + $transdate = $self->{transdate}; + } + } + + $query = + qq|SELECT date '$transdate' + $self->{terms_netto} AS netto_date, | . + qq|date '$transdate' + $self->{terms_skonto} AS skonto_date | . + qq|FROM payment_terms LIMIT 1|; + ($self->{netto_date}, $self->{skonto_date}) = + selectrow_query($self, $dbh, $query); + + my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal}; + my $skonto_amount = $self->parse_amount($myconfig, $total) * + $self->{percent_skonto}; + + $self->{skonto_amount} = + $self->format_amount($myconfig, $skonto_amount, 2); + + if ($self->{"language_id"}) { + $query = + qq|SELECT t.description_long, | . + qq|l.output_numberformat, l.output_dateformat, l.output_longdates | . + qq|FROM translation_payment_terms t | . + qq|LEFT JOIN language l ON t.language_id = l.id | . + qq|WHERE (t.language_id = ?) AND (t.payment_terms_id = ?)|; + my ($description_long, $output_numberformat, $output_dateformat, + $output_longdates) = + selectrow_query($self, $dbh, $query, + $self->{"language_id"}, $self->{"payment_id"}); + + $self->{payment_terms} = $description_long if ($description_long); + + if ($output_dateformat) { + foreach my $key (qw(netto_date skonto_date)) { + $self->{$key} = + $main::locale->reformat_date($myconfig, $self->{$key}, + $output_dateformat, + $output_longdates); + } + } + + if ($output_numberformat && + ($output_numberformat ne $myconfig->{"numberformat"})) { + my $saved_numberformat = $myconfig->{"numberformat"}; + $myconfig->{"numberformat"} = $output_numberformat; + $self->{skonto_amount} = + $self->format_amount($myconfig, $skonto_amount, 2); + $myconfig->{"numberformat"} = $saved_numberformat; + } + } + + $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; + $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; + $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g; + $self->{payment_terms} =~ s/<%total%>/$self->{total}/g; + $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g; + $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; + $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g; + $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; + $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; + $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; + + $dbh->disconnect; + } + + $main::lxdebug->leave_sub(); + +} sub check_exchangerate { $main::lxdebug->enter_sub(); @@ -1192,7 +1215,6 @@ sub check_exchangerate { return ""; } - my $dbh = $self->dbconnect($myconfig); my $query = qq|SELECT e.$fld FROM exchangerate e @@ -1204,42 +1226,139 @@ sub check_exchangerate { my ($exchangerate) = $sth->fetchrow_array; $sth->finish; $dbh->disconnect; - + $main::lxdebug->leave_sub(); return $exchangerate; } +sub get_template_language { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + + my $template_code = ""; + + if ($self->{language_id}) { + + my $dbh = $self->dbconnect($myconfig); + + + my $query = qq|SELECT l.template_code FROM language l + WHERE l.id = $self->{language_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + ($template_code) = $sth->fetchrow_array; + $sth->finish; + $dbh->disconnect; + } + + $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->dbconnect($myconfig); + + + my $query = qq|SELECT p.template_code,p.printer_command FROM printers p + WHERE p.id = $self->{printer_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + ($template_code, $self->{printer_command}) = $sth->fetchrow_array; + $sth->finish; + $dbh->disconnect; + } + + $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->dbconnect($myconfig); + + + my $query = qq|SELECT s.* FROM shipto s + WHERE s.shipto_id = $self->{shipto_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $self->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + $dbh->disconnect; + } + + $main::lxdebug->leave_sub(); + +} sub add_shipto { $main::lxdebug->enter_sub(); - my ($self, $dbh, $id) = @_; + my ($self, $dbh, $id, $module) = @_; ##LINET my $shipto; - foreach my $item (qw(name street zipcode city country contact phone fax email)) { + 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; } - if ($shipto) { - my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptostreet, + if ($self->{shipto_id}) { + my $query = qq| UPDATE shipto set + shiptoname = '$self->{shiptoname}', + shiptodepartment_1 = '$self->{shiptodepartment_1}', + shiptodepartment_2 = '$self->{shiptodepartment_2}', + shiptostreet = '$self->{shiptostreet}', + shiptozipcode = '$self->{shiptozipcode}', + shiptocity = '$self->{shiptocity}', + shiptocountry = '$self->{shiptocountry}', + shiptocontact = '$self->{shiptocontact}', + shiptophone = '$self->{shiptophone}', + shiptofax = '$self->{shiptofax}', + shiptoemail = '$self->{shiptoemail}' + WHERE shipto_id = $self->{shipto_id}|; + $dbh->do($query) || $self->dberror($query); + } else { + 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->{shiptostreet}', + shiptophone, shiptofax, shiptoemail, module) VALUES ($id, + '$self->{shiptoname}', '$self->{shiptodepartment_1}', '$self->{shiptodepartment_2}', '$self->{shiptostreet}', '$self->{shiptozipcode}', '$self->{shiptocity}', '$self->{shiptocountry}', '$self->{shiptocontact}', '$self->{shiptophone}', '$self->{shiptofax}', - '$self->{shiptoemail}')|; - $dbh->do($query) || $self->dberror($query); + '$self->{shiptoemail}', '$module')|; + $dbh->do($query) || $self->dberror($query); + } } ##/LINET $main::lxdebug->leave_sub(); } - sub get_employee { $main::lxdebug->enter_sub(); @@ -1258,64 +1377,166 @@ sub get_employee { $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 $query = qq|SELECT c.* - FROM contacts c - WHERE cp_id=$id|; - $sth = $dbh->prepare($query); + my ($self, $myconfig) = @_; + + my $dbh = $self->dbconnect($myconfig); + my $query = qq|SELECT current_date+terms_netto FROM payment_terms + WHERE id = '$self->{payment_id}'|; + my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - - push @{ $self->{$_} }, $ref; + + ($self->{duedate}) = $sth->fetchrow_array; + + $sth->finish; + + $main::lxdebug->leave_sub(); +} + +# get contacts for id, if no contact return {"","","","",""} +sub get_contacts { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $id, $key) = @_; + + $key = "all_contacts" unless ($key); + $self->{$key} = []; + + my $query = + qq|SELECT c.cp_id, c.cp_cv_id, c.cp_name, c.cp_givenname, c.cp_abteilung | . + qq|FROM contacts c | . + qq|WHERE cp_cv_id = ? | . + qq|ORDER BY lower(c.cp_name)|; + my $sth = $dbh->prepare($query); + $sth->execute($id) || $self->dberror($query . " ($id)"); + + my $i = 0; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{$key} }, $ref; + $i++; + } + + if ($i == 0) { + push @{ $self->{$key} }, { { "", "", "", "", "", "" } }; + } + $sth->finish; + $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)|; + my $sth = $dbh->prepare($query); + $sth->execute(@values) || + $self->dberror($query . " (" . join(", ", @values) . ")"); + + $self->{$key} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{ $self->{$key} }, $ref); + } $sth->finish; $main::lxdebug->leave_sub(); } -# get contacts for id, if no contact return {"","","","",""} -sub get_contacts { +sub get_lists { $main::lxdebug->enter_sub(); - my ($self, $dbh, $id) = @_; + my $self = shift; + my %params = @_; - 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); - - my $i = 0; - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - push @{ $self->{all_contacts} }, $ref; - $i++; + my $dbh = $self->dbconnect(\%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 ($i == 0) - { - push @{ $self->{all_contacts} }, {{"","","","",""}}; + + if ($params{"shipto"}) { + # get shipping addresses + $query = + qq|SELECT s.shipto_id,s.shiptoname,s.shiptodepartment_1 | . + qq|FROM shipto s | . + qq|WHERE s.trans_id = ?|; + $sth = $dbh->prepare($query); + $sth->execute($vc_id) || $self->dberror($query . " ($vc_id)"); + + $self->{$params{"shipto"}} = []; + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{ $self->{$params{"shipto"}} }, $ref); + } + $sth->finish; } - $sth->finish; + + if ($params{"projects"} || $params{"all_projects"}) { + $self->get_projects($dbh, $params{"all_projects"} ? + $params{"all_projects"} : $params{"projects"}, + $params{"all_projects"} ? 1 : 0); + } + + $dbh->disconnect(); + $main::lxdebug->leave_sub(); } - # this sub gets the id and name from $table sub get_name { $main::lxdebug->enter_sub(); my ($self, $myconfig, $table) = @_; + # connect to database my $dbh = $self->dbconnect($myconfig); - my $name = $self->like(lc $self->{$table}); + my $name = $self->like(lc $self->{$table}); my $customernumber = $self->like(lc $self->{customernumber}); - + if ($self->{customernumber} ne "") { $query = qq~SELECT c.id, c.name, c.street || ' ' || c.zipcode || ' ' || c.city || ' ' || c.country AS address @@ -1328,7 +1549,7 @@ sub get_name { FROM $table c WHERE (lower(c.name) LIKE '$name') AND (not c.obsolete) ORDER BY c.name~; - } + } if ($self->{openinvoices}) { $query = qq~SELECT DISTINCT c.id, c.name, @@ -1356,7 +1577,6 @@ sub get_name { return $i; } - # the selection sub is used in the AR, AP, IS, IR and OE module # sub all_vc { @@ -1368,7 +1588,7 @@ sub all_vc { my $dbh = $self->dbconnect($myconfig); my $query = qq|SELECT count(*) FROM $table|; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); my ($count) = $sth->fetchrow_array; $sth->finish; @@ -1406,12 +1626,16 @@ sub all_vc { $sth->finish; # 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} } = sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} }; + @{ $self->{all_employees} } = + sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} }; if ($module eq 'AR') { + # prepare query for departments $query = qq|SELECT d.id, d.description FROM department d @@ -1432,11 +1656,107 @@ sub all_vc { } $sth->finish; + # get languages + $query = qq|SELECT id, description + FROM language + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{languages} }, $ref; + } + $sth->finish; + + # get printer + $query = qq|SELECT printer_description, id + FROM printers + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{printers} }, $ref; + } + $sth->finish; + + # get payment terms + $query = qq|SELECT id, description + FROM payment_terms + ORDER BY sortkey|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{payment_terms} }, $ref; + } + $sth->finish; $dbh->disconnect; $main::lxdebug->leave_sub(); } +sub language_payment { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + undef $self->{languages}; + undef $self->{payment_terms}; + undef $self->{printers}; + + my $ref; + my $dbh = $self->dbconnect($myconfig); + # get languages + my $query = qq|SELECT id, description + FROM language + ORDER BY 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{languages} }, $ref; + } + $sth->finish; + + # get printer + $query = qq|SELECT printer_description, id + FROM printers + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{printers} }, $ref; + } + $sth->finish; + + # get payment terms + $query = qq|SELECT id, description + FROM payment_terms + ORDER BY sortkey|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{payment_terms} }, $ref; + } + $sth->finish; + + # get buchungsgruppen + $query = qq|SELECT id, description + FROM buchungsgruppen|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{BUCHUNGSGRUPPEN} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{BUCHUNGSGRUPPEN} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + $main::lxdebug->leave_sub(); +} # this is only used for reports sub all_departments { @@ -1444,7 +1764,7 @@ sub all_departments { my ($self, $myconfig, $table) = @_; - my $dbh = $self->dbconnect($myconfig); + my $dbh = $self->dbconnect($myconfig); my $where = "1 = 1"; if (defined $table) { @@ -1470,7 +1790,6 @@ sub all_departments { $main::lxdebug->leave_sub(); } - sub create_links { $main::lxdebug->enter_sub(); @@ -1482,33 +1801,69 @@ sub create_links { my ($query, $sth); my $dbh = $self->dbconnect($myconfig); - my %xkeyref = (); + if (!$self->{id}) { - # 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|; + my $transdate = "current_date"; + if ($self->{transdate}) { + $transdate = qq|'$self->{transdate}'|; + } + + # now get the account numbers + $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id + FROM chart c, taxkeys tk + WHERE c.link LIKE '%$module%' AND c.id=tk.chart_id AND tk.id = (SELECT id from taxkeys where taxkeys.chart_id =c.id AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) + ORDER BY c.accno|; + + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{accounts} = ""; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + foreach my $key (split(/:/, $ref->{link})) { + if ($key =~ /$module/) { + + # 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/; + } + } + } + } + + # get taxkeys and description + $query = qq|SELECT id, taxkey, taxdescription + FROM tax|; $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); - $self->{accounts} = ""; + $ref = $sth->fetchrow_hashref(NAME_lc); + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{TAXKEY} }, $ref; + } - foreach my $key (split /:/, $ref->{link}) { - if ($key =~ /$module/) { - # cross reference for keys - $xkeyref{$ref->{accno}} = $key; + $sth->finish; - push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, - description => $ref->{description}, taxkey => $ref->{taxkey_id} }; - $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; - } - } + # get tax zones + $query = qq|SELECT id, description + FROM tax_zones|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{TAXZONE} }, $ref; } $sth->finish; @@ -1516,9 +1871,9 @@ sub create_links { # get tax rates and description $query = qq| SELECT * FROM tax t|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); - $form->{TAX} = (); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + $self->{TAX} = (); while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { push @{ $self->{TAX} }, $ref; } @@ -1533,7 +1888,7 @@ sub create_links { a.taxincluded, a.curr AS currency, a.notes, a.intnotes, c.name AS $table, a.department_id, d.description AS department, a.amount AS oldinvtotal, a.paid AS oldtotalpaid, - a.employee_id, e.name AS employee, a.gldate + a.employee_id, e.name AS employee, a.gldate, a.type FROM $arap a JOIN $table c ON (a.${table}_id = c.id) LEFT JOIN employee e ON (e.id = a.employee_id) @@ -1541,38 +1896,87 @@ sub create_links { WHERE a.id = $self->{id}|; $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); - + $ref = $sth->fetchrow_hashref(NAME_lc); foreach $key (keys %$ref) { $self->{$key} = $ref->{$key}; } $sth->finish; + + my $transdate = "current_date"; + if ($self->{transdate}) { + $transdate = qq|'$self->{transdate}'|; + } + + # now get the account numbers + $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id + FROM chart c, taxkeys tk + WHERE c.link LIKE '%$module%' AND (((tk.chart_id=c.id) AND NOT(c.link like '%_tax%')) OR (NOT(tk.chart_id=c.id) AND (c.link like '%_tax%'))) AND (((tk.id = (SELECT id from taxkeys where taxkeys.chart_id =c.id AND startdate<=$transdate ORDER BY startdate desc LIMIT 1)) AND NOT(c.link like '%_tax%')) OR (c.link like '%_tax%')) + ORDER BY c.accno|; + + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{accounts} = ""; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + foreach my $key (split(/:/, $ref->{link})) { + if ($key =~ /$module/) { + + # 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/; + } + } + } + + # 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 + a.transdate, a.cleared, a.project_id, p.projectnumber, a.taxkey, t.rate, t.id FROM acc_trans a JOIN chart c ON (c.id = a.chart_id) LEFT JOIN project p ON (p.id = a.project_id) - LEFT Join tax t ON (a.taxkey = t.taxkey) - WHERE a.trans_id = $self->{id} + LEFT JOIN tax t ON (t.id=(SELECT tk.tax_id from taxkeys tk WHERE (tk.taxkey_id=a.taxkey) AND ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id=a.taxkey) THEN tk.chart_id=a.chart_id ELSE 1=1 END) OR (c.link='%tax%')) AND startdate <=a.transdate ORDER BY startdate DESC LIMIT 1)) + WHERE a.trans_id = $self->{id} AND a.fx_transaction = '0' - ORDER BY a.transdate|; + ORDER BY a.oid,a.transdate|; $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); my $fld = ($table eq 'customer') ? 'buy' : 'sell'; + # get exchangerate for currency - $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld); + $self->{exchangerate} = + $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)) { - $ref->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld); + $ref->{exchangerate} = + $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; + push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref; } - $sth->finish; + $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, @@ -1586,7 +1990,6 @@ sub create_links { map { $self->{$_} = $ref->{$_} } keys %$ref; $sth->finish; - } else { # get date @@ -1605,48 +2008,52 @@ sub create_links { $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->{exchangerate} = + $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, + $fld); } } + $sth->finish; + $dbh->disconnect; $main::lxdebug->leave_sub(); } - sub lastname_used { $main::lxdebug->enter_sub(); my ($self, $dbh, $myconfig, $table, $module) = @_; - my $arap = ($table eq 'customer') ? "ar" : "ap"; + my $arap = ($table eq 'customer') ? "ar" : "ap"; my $where = "1 = 1"; if ($self->{type} =~ /_order/) { - $arap = 'oe'; + $arap = 'oe'; $where = "quotation = '0'"; } if ($self->{type} =~ /_quotation/) { - $arap = 'oe'; + $arap = 'oe'; $where = "quotation = '1'"; } - my $query = qq|SELECT id FROM $arap - WHERE id IN (SELECT MAX(id) FROM $arap + my $query = qq|SELECT MAX(id) FROM $arap WHERE $where - AND ${table}_id > 0)|; + AND ${table}_id > 0|; my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); @@ -1664,14 +2071,14 @@ sub lastname_used { $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; + ($self->{$table}, $self->{currency}, $self->{"${table}_id"}, + $self->{duedate}, $self->{department_id}, $self->{department}) + = $sth->fetchrow_array; $sth->finish; $main::lxdebug->leave_sub(); } - - sub current_date { $main::lxdebug->enter_sub(); @@ -1687,13 +2094,13 @@ sub current_date { $query = qq|SELECT to_date('$thisdate', '$dateformat') + $days AS thisdate FROM defaults|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); } else { $query = qq|SELECT current_date AS thisdate FROM defaults|; - $sth = $dbh->prepare($query); - $sth->execute || $self->dberror($query); + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); } ($thisdate) = $sth->fetchrow_array; @@ -1706,7 +2113,6 @@ sub current_date { return $thisdate; } - sub like { $main::lxdebug->enter_sub(); @@ -1723,7 +2129,6 @@ sub like { return $string; } - sub redo_rows { $main::lxdebug->enter_sub(); @@ -1731,9 +2136,11 @@ 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++; @@ -1749,7 +2156,6 @@ sub redo_rows { $main::lxdebug->leave_sub(); } - sub update_status { $main::lxdebug->enter_sub(); @@ -1780,6 +2186,7 @@ sub update_status { my %queued = split / /, $self->{queued}; 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, @@ -1790,8 +2197,8 @@ sub update_status { for $i (1 .. $self->{rowcount}) { if ($self->{"checked_$i"}) { - $sth->execute($self->{"id_$i"}) || $self->dberror($query); - $sth->finish; + $sth->execute($self->{"id_$i"}) || $self->dberror($query); + $sth->finish; } } } else { @@ -1808,6 +2215,82 @@ sub update_status { $main::lxdebug->leave_sub(); } +#--- 4 locale ---# +# $main::locale->text('SAVED') +# $main::locale->text('DELETED') +# $main::locale->text('ADDED') +# $main::locale->text('PAYMENT POSTED') +# $main::locale->text('POSTED') +# $main::locale->text('POSTED AS NEW') +# $main::locale->text('ELSE') +# $main::locale->text('SAVED FOR DUNNING') +# $main::locale->text('DUNNING STARTED') +# $main::locale->text('PRINTED') +# $main::locale->text('MAILED') +# $main::locale->text('SCREENED') +# $main::locale->text('invoice') +# $main::locale->text('proforma') +# $main::locale->text('sales_order') +# $main::locale->text('packing_list') +# $main::locale->text('pick_list') +# $main::locale->text('purchase_order') +# $main::locale->text('bin_list') +# $main::locale->text('sales_quotation') +# $main::locale->text('request_quotation') + +sub save_history { + $main::lxdebug->enter_sub(); + + my $self = shift(); + my $dbh = shift(); + + if(!exists $self->{employee_id}) { + &get_employee($self, $dbh); + } + + my $query = + qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done) | . + qq|VALUES (?, ?, ?, ?)|; + my @values = (conv_i($self->{id}), conv_i($self->{employee_id}), + $self->{addition}, $self->{what_done}); + do_query($self, $dbh, $query, @values); + + $main::lxdebug->leave_sub(); +} + +sub get_history { + $main::lxdebug->enter_sub(); + + my $self = shift(); + my $dbh = shift(); + my $trans_id = shift(); + my $restriction = shift(); + my @tempArray; + my $i = 0; + if ($trans_id ne "") { + my $query = + qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name | . + qq|FROM history_erp h | . + qq|LEFT JOIN employee emp | . + qq|ON emp.id = h.employee_id | . + qq|WHERE trans_id = ? | + . $restriction; + + my $sth = $dbh->prepare($query) || $self->dberror($query); + + $sth->execute($trans_id) || $self->dberror("$query ($trans_id)"); + + while(my $hash_ref = $sth->fetchrow_hashref()) { + $hash_ref->{addition} = $main::locale->text($hash_ref->{addition}); + $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done}); + $tempArray[$i++] = $hash_ref; + } + $main::lxdebug->leave_sub() and return \@tempArray + if ($i > 0 && $tempArray[0] ne ""); + } + $main::lxdebug->leave_sub(); + return 0; +} sub save_status { $main::lxdebug->enter_sub(); @@ -1816,12 +2299,12 @@ sub save_status { my ($query, $printed, $emailed); - my $formnames = $self->{printed}; + my $formnames = $self->{printed}; my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status - WHERE formname = '$self->{formname}' - AND trans_id = $self->{id}|; + $query = qq|DELETE FROM status + WHERE formname = '$self->{formname}' + AND trans_id = $self->{id}|; $dbh->do($query) || $self->dberror($query); # this only applies to the forms @@ -1840,14 +2323,14 @@ sub save_status { '$queued{$formname}', '$formname')|; $dbh->do($query) || $self->dberror($query); - $formnames =~ s/$self->{formname}//; + $formnames =~ s/$self->{formname}//; $emailforms =~ s/$self->{formname}//; } } # save printed, emailed info - $formnames =~ s/^ +//g; + $formnames =~ s/^ +//g; $emailforms =~ s/^ +//g; my %status = (); @@ -1855,7 +2338,7 @@ sub save_status { map { $status{$_}{emailed} = 1 } split / +/, $emailforms; foreach my $formname (keys %status) { - $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, formname) @@ -1866,15 +2349,14 @@ sub save_status { $main::lxdebug->leave_sub(); } - sub update_defaults { $main::lxdebug->enter_sub(); my ($self, $myconfig, $fld) = @_; - my $dbh = $self->dbconnect_noauto($myconfig); + my $dbh = $self->dbconnect_noauto($myconfig); my $query = qq|SELECT $fld FROM defaults FOR UPDATE|; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); my ($var) = $sth->fetchrow_array; @@ -1884,7 +2366,7 @@ sub update_defaults { $query = qq|UPDATE defaults SET $fld = '$var'|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $self->dberror($query); $dbh->commit; $dbh->disconnect; @@ -1899,8 +2381,9 @@ sub update_business { my ($self, $myconfig, $business_id) = @_; - my $dbh = $self->dbconnect_noauto($myconfig); - my $query = qq|SELECT customernumberinit FROM business WHERE id=$business_id FOR UPDATE|; + my $dbh = $self->dbconnect_noauto($myconfig); + my $query = + qq|SELECT customernumberinit FROM business WHERE id=$business_id FOR UPDATE|; my $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); @@ -1911,7 +2394,7 @@ sub update_business { } $query = qq|UPDATE business SET customernumberinit = '$var' WHERE id=$business_id|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $self->dberror($query); $dbh->commit; $dbh->disconnect; @@ -1926,8 +2409,9 @@ sub get_salesman { my ($self, $myconfig, $salesman) = @_; - my $dbh = $self->dbconnect($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 $dbh = $self->dbconnect($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); @@ -1935,12 +2419,12 @@ sub get_salesman { while ($ref = $sth->fetchrow_hashref(NAME_lc)) { push(@{ $self->{salesman_list} }, $ref); $i++; - } + } $dbh->commit; $main::lxdebug->leave_sub(); return $i; -} +} sub get_partsgroup { $main::lxdebug->enter_sub(); @@ -1976,7 +2460,7 @@ sub get_partsgroup { if ($p->{all}) { $query = qq|SELECT id, partsgroup FROM partsgroup ORDER BY partsgroup|; - } + } if ($p->{language_code}) { $query = qq|SELECT DISTINCT pg.id, pg.partsgroup, @@ -1999,169 +2483,174 @@ sub get_partsgroup { $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"; }; - } + my ($self, $myconfig, $p) = @_; - $self->{NLS_file} = $NLS_file; + my $dbh = $self->dbconnect($myconfig); - 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)); + my $query = qq|SELECT p.id, p.pricegroup + FROM pricegroup p|; - $main::lxdebug->leave_sub(); + $query .= qq| + ORDER BY pricegroup|; - bless $self, $type; -} + if ($p->{all}) { + $query = qq|SELECT id, pricegroup FROM pricegroup + ORDER BY pricegroup|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); -sub text { - my ($self, $text) = @_; + $self->{all_pricegroup} = (); + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_pricegroup} }, $ref; + } + $sth->finish; + $dbh->disconnect; - return (exists $self{texts}{$text}) ? $self{texts}{$text} : $text; + $main::lxdebug->leave_sub(); } +sub audittrail { + my ($self, $dbh, $myconfig, $audittrail) = @_; -sub findsub { - $main::lxdebug->enter_sub(); + # table, $reference, $formname, $action, $id, $transdate) = @_; - my ($self, $text) = @_; + my $query; + my $rv; + my $disconnect; - 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 (!$dbh) { + $dbh = $self->dbconnect($myconfig); + $disconnect = 1; } - $main::lxdebug->leave_sub(); + # if we have an id add audittrail, otherwise get a new timestamp - return $text; -} + if ($audittrail->{id}) { + $query = qq|SELECT audittrail FROM defaults|; -sub date { - $main::lxdebug->enter_sub(); + if ($dbh->selectrow_array($query)) { + my ($null, $employee_id) = $self->get_employee($dbh); - my ($self, $myconfig, $date, $longformat) = @_; + if ($self->{audittrail} && !$myconfig) { + chop $self->{audittrail}; - my $longdate = ""; - my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH'; + my @a = split /\|/, $self->{audittrail}; + my %newtrail = (); + my $key; + my $i; + my @flds = qw(tablename reference formname action transdate); - if ($date) { - # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 1, 1); + # put into hash and remove dups + while (@a) { + $key = "$a[2]$a[3]"; + $i = 0; + $newtrail{$key} = { map { $_ => $a[$i++] } @flds }; + splice @a, 0, 5; + } - 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; + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id, transdate) + VALUES ($audittrail->{id}, ?, ?, + ?, ?, $employee_id, ?)|; + my $sth = $dbh->prepare($query) || $self->dberror($query); + + foreach $key ( + sort { + $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} + } keys %newtrail + ) { + $i = 1; + for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) } + + $sth->execute || $self->dberror; + $sth->finish; + } } - } else { - $date = substr($date, 2); - ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); - } - $dd *= 1; - $mm--; - $yy = ($yy < 70) ? $yy + 2000 : $yy; - $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; - - 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"; + if ($audittrail->{transdate}) { + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id, transdate) VALUES ( + $audittrail->{id}, '$audittrail->{tablename}', | + . $dbh->quote($audittrail->{reference}) . qq|, + '$audittrail->{formname}', '$audittrail->{action}', + $employee_id, '$audittrail->{transdate}')|; } else { - $longdate = &text($self, $self->{$longmonth}[$mm])." $dd, $yy"; + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id) VALUES ($audittrail->{id}, + '$audittrail->{tablename}', | + . $dbh->quote($audittrail->{reference}) . qq|, + '$audittrail->{formname}', '$audittrail->{action}', + $employee_id)|; } + $dbh->do($query); } + } else { + + $query = qq|SELECT current_timestamp FROM defaults|; + my ($timestamp) = $dbh->selectrow_array($query); + $rv = + "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|"; } - $main::lxdebug->leave_sub(); + $dbh->disconnect if $disconnect; - return $longdate; -} + $rv; -sub parse_date { - $main::lxdebug->enter_sub(); +} - my ($self, $myconfig, $date, $longformat) = @_; - unless ($date) { - $main::lxdebug->leave_sub(); - return (); - } +sub all_years { +# usage $form->all_years($myconfig, [$dbh]) +# return list of all years where bookings found +# (@all_years) - # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 1, 1); + $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, $myconfig, $dbh) = @_; + + my $disconnect = 0; + if (! $dbh) { + $dbh = $self->dbconnect($myconfig); + $disconnect = 1; + } + + # get years + my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans), + (SELECT MAX(transdate) FROM acc_trans) + FROM defaults|; + my ($startdate, $enddate) = $dbh->selectrow_array($query); + + if ($myconfig->{dateformat} =~ /^yy/) { + ($startdate) = split /\W/, $startdate; + ($enddate) = split /\W/, $enddate; + } else { + (@_) = split /\W/, $startdate; + $startdate = $_[2]; + (@_) = split /\W/, $enddate; + $enddate = $_[2]; + } + + my @all_years; + $startdate = substr($startdate,0,4); + $enddate = substr($enddate,0,4); + + while ($enddate >= $startdate) { + push @all_years, $enddate--; } - $dd *= 1; - $mm *= 1; - $yy = ($yy < 70) ? $yy + 2000 : $yy; - $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + $dbh->disconnect if $disconnect; + + return @all_years; $main::lxdebug->leave_sub(); - return ($yy, $mm, $dd); } -1; +1;