CGI::Ajax Example

From: Moritz Bunkus Date: Mon, 18 Dec 2006 08:02:16 +0000 (+0000) Subject: Kopie von unstable mit Stand Release 2.4.0. X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/commitdiff_plain/f20265adf22d6cb546612bf54268004f7fe64698?hp=43a19768b1c750bdc915136bcc50f0b2d5a21d58 Kopie von unstable mit Stand Release 2.4.0. --- diff --git a/CGI/Ajax.pm b/CGI/Ajax.pm new file mode 100644 index 000000000..41e9c3342 --- /dev/null +++ b/CGI/Ajax.pm @@ -0,0 +1,1215 @@ +package CGI::Ajax; +use strict; +use Data::Dumper; +use base qw(Class::Accessor); +use overload '""' => 'show_javascript'; # for building web pages, so + # you can just say: print $pjx +BEGIN { + use vars qw ($VERSION @ISA @METHODS); + @METHODS = qw(url_list coderef_list DEBUG JSDEBUG html + js_encode_function cgi_header_extra); + + CGI::Ajax->mk_accessors( @METHODS ); + + $VERSION = .697; +} + +########################################### main pod documentation begin ## + +=head1 NAME + +CGI::Ajax - a perl-specific system for writing Asynchronous web +applications + +=head1 SYNOPSIS + + use strict; + use CGI; # or any other CGI:: form handler/decoder + use CGI::Ajax; + + my $cgi = new CGI; + my $pjx = new CGI::Ajax( 'exported_func' => \&perl_func ); + + print $pjx->build_html( $cgi, \&Show_HTML); + + sub perl_func { + my $input = shift; + # do something with $input + my $output = $input . " was the input!"; + return( $output ); + } + + sub Show_HTML { + my $html = < + + Enter something: + +
+

+ + + EOHTML + return $html; + } + +I + +=head1 DESCRIPTION + +CGI::Ajax is an object-oriented module that provides a unique +mechanism for using perl code asynchronously from javascript- +enhanced HTML pages. CGI::Ajax unburdens the user from having to +write extensive javascript, except for associating an exported +method with a document-defined event (such as onClick, onKeyUp, +etc). CGI::Ajax also mixes well with HTML containing more complex +javascript. + +CGI::Ajax supports methods that return single results or multiple +results to the web page, and supports returning values to multiple +DIV elements on the HTML page. + +Using CGI::Ajax, the URL for the HTTP GET/POST request is +automatically generated based on HTML layout and events, and the +page is then dynamically updated with the output from the perl +function. Additionally, CGI::Ajax supports mapping URL's to a +CGI::Ajax function name, so you can separate your code processing +over multiple scripts. + +Other than using the Class::Accessor module to generate CGI::Ajax' +accessor methods, CGI::Ajax is completely self-contained - it +does not require you to install a larger package or a full Content +Management System, etc. + +We have added I for other CGI handler/decoder modules, +like L or L, but we can't test these +since we run mod_perl2 only here. CGI::Ajax checks to see if a +header() method is available to the CGI object, and then uses it. +If method() isn't available, it creates it's own minimal header. + +A primary goal of CGI::Ajax is to keep the module streamlined and +maximally flexible. We are trying to keep the generated javascript +code to a minimum, but still provide users with a variety of +methods for deploying CGI::Ajax. And VERY little user javascript. + +=head1 EXAMPLES + +The CGI::Ajax module allows a Perl subroutine to be called +asynchronously, when triggered from a javascript event on the +HTML page. To do this, the subroutine must be I, +usually done during: + + my $pjx = new CGI::Ajax( 'JSFUNC' => \&PERLFUNC ); + +This maps a perl subroutine (PERLFUNC) to an automatically +generated Javascript function (JSFUNC). Next you setup a trigger this +function when an event occurs (e.g. "onClick"): + + onClick="JSFUNC(['source1','source2'], ['dest1','dest2']);" + +where 'source1', 'dest1', 'source2', 'dest2' are the DIV ids of +HTML elements in your page... + + + +

+ +L sends the values from source1 and source2 to your +Perl subroutine and returns the results to dest1 and dest2. + +=head2 4 Usage Methods + +=over 4 + +=item 1 Standard CGI::Ajax example + +Start by defining a perl subroutine that you want available from +javascript. In this case we'll define a subrouting that determines +whether or not an input is odd, even, or not a number (NaN): + + use strict; + use CGI::Ajax; + use CGI; + + + sub evenodd_func { + my $input = shift; + + # see if input is defined + if ( not defined $input ) { + return("input not defined or NaN"); + } + + # see if value is a number (*thanks Randall!*) + if ( $input !~ /\A\d+\z/ ) { + return("input is NaN"); + } + + # got a number, so mod by 2 + $input % 2 == 0 ? return("EVEN") : return("ODD"); + } + +Alternatively, we could have used coderefs to associate an +exported name... + + my $evenodd_func = sub { + # exactly the same as in the above subroutine + }; + +Next we define a function to generate the web page - this can +be done many different ways, and can also be defined as an +anonymous sub. The only requirement is that the sub send back +the html of the page. You can do this via a string containing the +html, or from a coderef that returns the html, or from a function +(as shown here)... + + sub Show_HTML { + my $html = < + CGI::Ajax Example + + + Enter a number: + +
+

+ + +EOT + return $html; + } + +The exported Perl subrouting is triggered using the C +event handler of the input HTML element. The subroutine takes one +value from the form, the input element B<'val1'>, and returns the +the result to an HTML div element with an id of B<'resultdiv'>. +Sending in the input id in an array format is required to support +multiple inputs, and similarly, to output multiple the results, +you can use an array for the output divs, but this isn't mandatory - +as will be explained in the B usage. + +Now create a CGI object and a CGI::Ajax object, associating a reference +to our subroutine with the name we want available to javascript. + + my $cgi = new CGI(); + my $pjx = new CGI::Ajax( 'evenodd' => \&evenodd_func ); + +And if we used a coderef, it would look like this... + + my $pjx = new CGI::Ajax( 'evenodd' => $evenodd_func ); + +Now we're ready to print the output page; we send in the cgi +object and the HTML-generating function. + + print $pjx->build_html($cgi,\&Show_HTML); + +CGI::Ajax has support for passing in extra HTML header information +to the CGI object. This can be accomplished by adding a third +argument to the build_html() call. The argument needs to be a +hashref containing Key=>value pairs that CGI objects understand: + + print $pjx->build_html($cgi,\&Show_HTML, + {-charset=>'UTF-8, -expires=>'-1d'}); + +See L for more header() method options. + +That's it for the CGI::Ajax standard method. Let's look at +something more advanced. + +=item 2 Advanced CGI::Ajax example + +Let's say we wanted to have a perl subroutine process multiple +values from the HTML page, and similarly return multiple values +back to distinct divs on the page. This is easy to do, and +requires no changes to the perl code - you just create it as you +would any perl subroutine that works with multiple input values +and returns multiple values. The significant change happens in +the event handler javascript in the HTML... + + onClick="exported_func(['input1','input2'],['result1','result2']);" + +Here we associate our javascript function ("exported_func") with +two HTML element ids ('input1','input2'), and also send in two +HTML element ids to place the results in ('result1','result2'). + +=item 3 Sending Perl Subroutine Output to a Javascript function + +Occassionally, you might want to have a custom javascript function +process the returned information from your Perl subroutine. +This is possible, and the only requierment is that you change +your event handler code... + + onClick="exported_func(['input1'],[js_process_func]);" + +In this scenario, C is a javascript function you +write to take the returned value from your Perl subroutine and +process the results. I Beware that with this usage, B. If the exported Perl subroutine returns, e.g. 2 +values, then C would need to process the input +by working through an array, or using the javascript Function +C object. + + function js_process_func() { + var input1 = arguments[0] + var input2 = arguments[1]; + // do something and return results, or set HTML divs using + // innerHTML + document.getElementById('outputdiv').innerHTML = input1; + } + +=item 4 URL/Outside Script CGI::Ajax example + +There are times when you may want a different script to +return content to your page. This could be because you have +an existing script already written to perform a particular +task, or you want to distribute a part of your application to another +script. This can be accomplished in L by using a URL in +place of a locally-defined Perl subroutine. In this usage, +you alter you creation of the L object to link an +exported javascript function name to a local URL instead of +a coderef or a subroutine. + + my $url = 'scripts/other_script.pl'; + my $pjx = new CGI::Ajax( 'external' => $url ); + +This will work as before in terms of how it is called from you +event handler: + + onClick="external(['input1','input2'],['resultdiv']);" + +The other_script.pl will get the values via a CGI object and +accessing the 'args' key. The values of the B<'args'> key will +be an array of everything that was sent into the script. + + my @input = $cgi->params('args'); + $input[0]; # contains first argument + $input[1]; # contains second argument, etc... + +This is good, but what if you need to send in arguments to the +other script which are directly from the calling Perl script, +i.e. you want a calling Perl script's variable to be sent, not +the value from an HTML element on the page? This is possible +using the following syntax: + + onClick="exported_func(['args__$input1','args__$input2'], + ['resultdiv']);" + +Similary, if the external script required a constant as input +(e.g. C, you would use this syntax: + + onClick="exported_func(['args__42'],['resultdiv']);" + +In both of the above examples, the result from the external +script would get placed into the I element on our +(the calling script's) page. + +If you are sending more than one argument from an external perl +script back to a javascript function, you will need to split the +string (AJAX applications communicate in strings only) on something. +Internally, we use '__pjx__', and this string is checked for. If +found, L will automatically split it. However, if you +don't want to use '__pjx__', you can do it yourself: + +For example, from your Perl script, you would... + + return("A|B"); # join with "|" + +and then in the javascript function you would have something like... + + process_func() { + var arr = arguments[0].split("|"); + // arr[0] eq 'A' + // arr[1] eq 'B' + } + +In order to rename parameters, in case the outside script needs +specifically-named parameters and not CGI::Ajax' I<'args'> default +parameter name, change your event handler associated with an HTML +event like this + + onClick="exported_func(['myname__$input1','myparam__$input2'], + ['resultdiv']);" + +The URL generated would look like this... + +C + +You would then retrieve the input in the outside script with this... + + my $p1 = $cgi->params('myname'); + my $p1 = $cgi->params('myparam'); + +Finally, what if we need to get a value from our HTML page and we +want to send that value to an outside script but the outside script +requires a named parameter different from I<'args'>? You can +accomplish this with L using the getVal() javascript +method (which returns an array, thus the C notation): + + onClick="exported_func(['myparam__' + getVal('div_id')[0]], + ['resultdiv']);" + +This will get the value of our HTML element with and +I of I, and submit it to the url attached to +I. So if our exported handler referred to a URI +called I'; + return $rv; +} + +## new +sub new { + my ($class) = shift; + my $self = bless ({}, ref ($class) || $class); +# $self->SUPER::new(); + $self->JSDEBUG(0); # turn javascript debugging off (if on, + # extra info will be added to the web page output + # if set to 1, then the core js will get + # compressed, but the user-defined functions will + # not be compressed. If set to 2 (or anything + # greater than 1 or 0), then none of the + # javascript will get compressed. + # + $self->DEBUG(0); # turn debugging off (if on, check web logs) + + #accessorized attributes + $self->coderef_list({}); + $self->url_list({}); + #$self->html(""); + #$self->cgi(); + #$self->cgi_header_extra(""); # set cgi_header_extra to an empty string + + # setup a default endcoding; if you need support for international + # charsets, use 'escape' instead of encodeURIComponent. Due to the + # number of browser problems users report about scripts with a default of + # encodeURIComponent, we are setting the default to 'escape' + $self->js_encode_function('escape'); + + if ( @_ < 2 ) { + die "incorrect usage: must have fn=>code pairs in new\n"; + } + + while ( @_ ) { + my($function_name,$code) = splice( @_, 0, 2 ); + if ( ref( $code ) eq "CODE" ) { + if ( $self->DEBUG() ) { + print STDERR "name = $function_name, code = $code\n"; + } + # add the name/code to hash + $self->coderef_list()->{ $function_name } = $code; + } elsif ( ref($code) ) { + die "Unsuported code block/url\n"; + } else { + if ( $self->DEBUG() ) { + print STDERR "Setting function $function_name to url $code\n"; + } + # if it's a url, it is added here + $self->url_list()->{ $function_name } = $code; + } + } + return ($self); +} + +###################################################### +## METHODS - private ## +###################################################### + +# sub cgiobj(), cgi() +# +# Purpose: accessor method to associate a CGI object with our +# CGI::Ajax object +# Arguments: a CGI object +# Returns: CGI::Ajax objects cgi object +# Called By: originating cgi script, or build_html() +# +sub cgiobj { + my $self = shift; + # see if any values were sent in... + if ( @_ ) { + my $cgi = shift; + # add support for other CGI::* modules This requires that your web server + # be configured properly. I can't test anything but a mod_perl2 + # setup, so this prevents me from testing CGI::Lite,CGI::Simple, etc. + if ( ref($cgi) =~ /CGI.*/ ) { + if ( $self->DEBUG() ) { + print STDERR "cgiobj() received a CGI-like object ($cgi)\n"; + } + $self->{'cgi'} = $cgi; + } else { + die "CGI::Ajax -- Can't set internal CGI object to a non-CGI object ($cgi)\n"; + } + } + # return the object + return( $self->{'cgi'} ); +} + +sub cgi { + my $self = shift; + if ( @_ ) { + return( $self->cgiobj( @_ ) ); + } else { + return( $self->cgiobj() ); + } +} + +## # sub cgi_header_extra +## # +## # Purpose: accessor method to associate CGI header information +## # with the CGI::Ajax object +## # Arguments: a hashref with key=>value pairs that get handed off to +## # the CGI object's header() method +## # Returns: hashref of extra cgi header params +## # Called By: originating cgi script, or build_html() +## +## sub cgi_header_extra { +## my $self = shift; +## if ( @_ ) { +## $self->{'cgi_header_extra'} = shift; +## } +## return( $self->{'cgi_header_extra'} ); +## } + +# sub create_js_setRequestHeader +# +# Purpose: create text of the header for the javascript side, +# xmlhttprequest call +# Arguments: none +# Returns: text of header to pass to xmlhttpreq call so it will +# match whatever was setup for the main web-page +# Called By: originating cgi script, or build_html() +# + +sub create_js_setRequestHeader { + my $self = shift; + my $cgi_header_extra = $self->cgi_header_extra(); + my $js_header_string = q{r.setRequestHeader("}; + #$js_header_string .= $self->cgi()->header( $cgi_header_extra ); + $js_header_string .= $self->cgi()->header(); + $js_header_string .= q{");}; + #if ( ref $cgi_header_extra eq "HASH" ) { + # foreach my $k ( keys(%$cgi_header_extra) ) { + # $js_header_string .= $self->cgi()->header($cgi_headers) + # } + #} else { + #print STDERR $self->cgi()->header($cgi_headers) ; + + if ( $self->DEBUG() ) { + print STDERR "js_header_string is (", $js_header_string, ")\n"; + } + + return($js_header_string); +} + +# sub show_common_js() +# +# Purpose: create text of the javascript needed to interface with +# the perl functions +# Arguments: none +# Returns: text of common javascript subroutine, 'do_http_request' +# Called By: originating cgi script, or build_html() +# + +sub show_common_js { + my $self = shift; + my $encodefn = $self->js_encode_function(); + my $decodefn = $encodefn; + $decodefn =~ s/^(en)/de/; + $decodefn =~ s/^(esc)/unesc/; + #my $request_header_str = $self->create_js_setRequestHeader(); + my $request_header_str = ""; + my $rv = <

";
+    for( var i=0; i < ajax.length; i++ ) {
+      tmp += '' +
+      decodeURI(ajax[i].url) + ' 
';
+    }
+    document.getElementById('pjxdebugrequest').innerHTML = tmp + "

"; +} + +EOT + + if ( $self->JSDEBUG() <= 1 ) { + $rv = $self->compress_js($rv); + } + + return($rv); +} + +# sub compress_js() +# +# Purpose: searches the javascript for newlines and spaces and +# removes them (if a newline) or shrinks them to a single (if +# space). +# Arguments: javascript to compress +# Returns: compressed js string +# Called By: show_common_js(), +# + +sub compress_js { + my($self,$js) = @_; + return if not defined $js; + return if $js eq ""; + $js =~ s/\n//g; # drop newlines + $js =~ s/\s+/ /g; # replace 1+ spaces with just one space + return $js; +} + + +# sub insert_js_in_head() +# +# Purpose: searches the html value in the CGI::Ajax object and inserts +# the ajax javascript code in the section, +# or if no such section exists, then it creates it. If +# JSDEBUG is set, then an extra div will be added and the +# url wil be desplayed as a link +# Arguments: none +# Returns: none +# Called By: build_html() +# + +sub insert_js_in_head{ + my $self = shift; + my $mhtml = $self->html(); + my $newhtml; + my @shtml; + my $js = $self->show_javascript(); + + if ( $self->JSDEBUG() ) { + my $showurl=qq!

!; + # find the terminal so we can insert just before it + my @splith = $mhtml =~ /(.*)(<\s*\/\s*body[^>]*>?)(.*)/is; + $mhtml = $splith[0].$showurl.$splith[1].$splith[2]; + } + + # see if we can match on + @shtml= $mhtml =~ /(.*)(<\s*head[^>]*>?)(.*)/is; + if ( @shtml ) { + # yes, there's already a , so let's insert inside it, + # at the beginning + $newhtml = $shtml[0].$shtml[1].$js.$shtml[2]; + } elsif( @shtml= $mhtml =~ /(.*)(<\s*html[^>]*>?)(.*)/is){ + # there's no , so look for the tag, and insert out + # javascript inside that tag + $newhtml = $shtml[0].$shtml[1].$js.$shtml[2]; + } else { + $newhtml .= ""; + $newhtml .= $js; + $newhtml .= ""; + $newhtml .= "No head/html tags, nowhere to insert. Returning javascript anyway
"; + $newhtml .= ""; + } + $self->html($newhtml); + return; +} + +# sub handle_request() +# +# Purpose: makes sure a fname function name was set in the CGI +# object, and then tries to eval the function with +# parameters sent in on args +# Arguments: none +# Returns: the result of the perl subroutine, as text; if multiple +# arguments are sent back from the defined, exported perl +# method, then join then with a connector (__pjx__). +# Called By: build_html() +# + +sub handle_request { + my ($self) = shift; + + my $result; # $result takes the output of the function, if it's an + # array split on __pjx__ + my @other = (); # array for catching extra parameters + + # we need to access "fname" in the form from the web page, so make + # sure there is a CGI object defined + return undef unless defined $self->cgi(); + + my $rv = ""; + if ( $self->cgi()->can('header') ) { + $rv = $self->cgi()->header( $self->cgi_header_extra() ); + } else { + # don't have an object with a "header()" method, so just create + # a mimimal one + $rv = "Content-Type: text/html;"; + # TODO: + $rv .= $self->cgi_header_extra(); + $rv .= "\n\n"; + } + + # get the name of the function + my $func_name = $self->cgi()->param("fname"); + + # check if the function name was created + if ( defined $self->coderef_list()->{$func_name} ) { + my $code = $self->coderef_list()->{$func_name}; + + # eval the code from the coderef, and append the output to $rv + if ( ref($code) eq "CODE" ) { + eval { ($result, @other) = $code->( $self->cgi()->param("args") ) }; + + if ($@) { + # see if the eval caused and error and report it + # Should we be more severe and die? + if ( $self->DEBUG() ) { + print STDERR "Problem with code: $@\n"; + } + } + + if( @other ) { + $rv .= join( "__pjx__", ($result, @other) ); + if ( $self->DEBUG() ) { + print STDERR "rv = $rv\n"; + } + } else { + if ( defined $result ) { + $rv .= $result; + } + } + + } # end if ref = CODE + } else { + # # problems with the URL, return a CGI rrror + print STDERR "POSSIBLE SECURITY INCIDENT! Browser from ", $self->cgi()->remote_addr(); + print STDERR "\trequested URL: ", $self->cgi()->url(); + print STDERR "\tfname request: ", $self->cgi()->param('fname'); + print STDERR " -- returning Bad Request status 400\n"; + if ( $self->cgi()->can('header') ) { + return($self->cgi()->header( -status=>'400' )); + } else { + # don't have an object with a "header()" method, so just create + # a mimimal one with 400 error + $rv = "Status: 400\nContent-Type: text/html;\n\n"; + } + } + return $rv; +} + + +# sub make_function() +# +# Purpose: creates the javascript wrapper for the underlying perl +# subroutine +# Arguments: CGI object from web form, and the name of the perl +# function to export to javascript, or a url if the +# function name refers to another cgi script +# Returns: text of the javascript-wrapped perl subroutine +# Called By: show_javascript; called once for each registered perl +# subroutine +# + +sub make_function { + my ($self, $func_name ) = @_; + return("") if not defined $func_name; + return("") if $func_name eq ""; + my $rv = ""; + my $script = $0 || $ENV{SCRIPT_FILENAME}; + $script =~ s/.*[\/|\\](.+)$/$1/; + my $outside_url = $self->url_list()->{ $func_name }; + my $url = defined $outside_url ? $outside_url : $script; + if ($url =~ /\?/) { $url.='&'; } else {$url.='?'} + $url = "'$url'"; + my $jsdebug = ""; + if ( $self->JSDEBUG()) { + $jsdebug = "jsdebug()"; + } + + #create the javascript text + $rv .= <JSDEBUG() ) { + $rv = $self->compress_js($rv); + } + return $rv; +} + +=item register() + + Purpose: adds a function name and a code ref to the global coderef + hash, after the original object was created + Arguments: function name, code reference + Returns: none + Called By: originating web script + +=cut + +sub register { + my ( $self, $fn, $coderef ) = @_; + # coderef_list() is a Class::Accessor function + # url_list() is a Class::Accessor function + if ( ref( $coderef ) eq "CODE" ) { + $self->coderef_list()->{$fn} = $coderef; + } elsif ( ref($coderef) ) { + die "Unsupported code/url type - error\n"; + } else { + $self->url_list()->{$fn} = $coderef; + } +} + +=item JSDEBUG() + + Purpose: Show the AJAX URL that is being generated, and stop + compression of the generated javascript, both of which can aid + during debugging. If set to 1, then the core js will get + compressed, but the user-defined functions will not be + compressed. If set to 2 (or anything greater than 1 or 0), + then none of the javascript will get compressed. + + Arguments: JSDEBUG(0); # turn javascript debugging off + JSDEBUG(1); # turn javascript debugging on, some javascript compression + JSDEBUG(2); # turn javascript debugging on, no javascript compresstion + Returns: prints a link to the url that is being generated automatically by + the Ajax object. this is VERY useful for seeing what + CGI::Ajax is doing. Following the link, will show a page + with the output that the page is generating. + + Called By: $pjx->JSDEBUG(1) # where $pjx is a CGI::Ajax object; + +=item DEBUG() + + Purpose: Show debugging information in web server logs + Arguments: DEBUG(0); # turn debugging off (default) + DEBUG(1); # turn debugging on + Returns: prints debugging information to the web server logs using + STDERR + Called By: $pjx->DEBUG(1) # where $pjx is a CGI::Ajax object; + +=back + +=head1 BUGS + +Follow any bugs at our homepage.... + + http://www.perljax.us + +=head1 SUPPORT + +Check out the news/discussion/bugs lists at our homepage: + + http://www.perljax.us + +=head1 AUTHORS + + Brian C. Thomas Brent Pedersen + CPAN ID: BCT + bct.x42@gmail.com bpederse@gmail.com + +=head1 A NOTE ABOUT THE MODULE NAME + +This module was initiated using the name "Perljax", but then +registered with CPAN under the WWW group "CGI::", and so became +"CGI::Perljax". Upon further deliberation, we decided to change it's +name to L. + +=head1 COPYRIGHT + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +The full text of the license can be found in the +LICENSE file included with this module. + +=head1 SEE ALSO + +L +L +L + +=cut + +1; +__END__ diff --git a/CGI/LICENSE b/CGI/LICENSE new file mode 100644 index 000000000..9d0305b3f --- /dev/null +++ b/CGI/LICENSE @@ -0,0 +1,383 @@ +Terms of Perl itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--------------------------------------------------------------------------- + +The General Public License (GPL) +Version 2, June 1991 + +Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, +Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute +verbatim copies of this license document, but changing it is not allowed. + +Preamble + +The licenses for most software are designed to take away your freedom to share +and change it. By contrast, the GNU General Public License is intended to +guarantee your freedom to share and change free software--to make sure the +software is free for all its users. This General Public License applies to most of +the Free Software Foundation's software and to any other program whose +authors commit to using it. (Some other Free Software Foundation software is +covered by the GNU Library General Public License instead.) You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our +General Public Licenses are designed to make sure that you have the freedom +to distribute copies of free software (and charge for this service if you wish), that +you receive source code or can get it if you want it, that you can change the +software or use pieces of it in new free programs; and that you know you can do +these things. + +To protect your rights, we need to make restrictions that forbid anyone to deny +you these rights or to ask you to surrender the rights. These restrictions +translate to certain responsibilities for you if you distribute copies of the +software, or if you modify it. + +For example, if you distribute copies of such a program, whether gratis or for a +fee, you must give the recipients all the rights that you have. You must make +sure that they, too, receive or can get the source code. And you must show +them these terms so they know their rights. + +We protect your rights with two steps: (1) copyright the software, and (2) offer +you this license which gives you legal permission to copy, distribute and/or +modify the software. + +Also, for each author's protection and ours, we want to make certain that +everyone understands that there is no warranty for this free software. If the +software is modified by someone else and passed on, we want its recipients to +know that what they have is not the original, so that any problems introduced by +others will not reflect on the original authors' reputations. + +Finally, any free program is threatened constantly by software patents. We wish +to avoid the danger that redistributors of a free program will individually obtain +patent licenses, in effect making the program proprietary. To prevent this, we +have made it clear that any patent must be licensed for everyone's free use or +not licensed at all. + +The precise terms and conditions for copying, distribution and modification +follow. + +GNU GENERAL PUBLIC LICENSE +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND +MODIFICATION + +0. This License applies to any program or other work which contains a notice +placed by the copyright holder saying it may be distributed under the terms of +this General Public License. The "Program", below, refers to any such program +or work, and a "work based on the Program" means either the Program or any +derivative work under copyright law: that is to say, a work containing the +Program or a portion of it, either verbatim or with modifications and/or translated +into another language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not covered by +this License; they are outside its scope. The act of running the Program is not +restricted, and the output from the Program is covered only if its contents +constitute a work based on the Program (independent of having been made by +running the Program). Whether that is true depends on what the Program does. + +1. You may copy and distribute verbatim copies of the Program's source code as +you receive it, in any medium, provided that you conspicuously and appropriately +publish on each copy an appropriate copyright notice and disclaimer of warranty; +keep intact all the notices that refer to this License and to the absence of any +warranty; and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and you may at +your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Program or any portion of it, thus +forming a work based on the Program, and copy and distribute such +modifications or work under the terms of Section 1 above, provided that you also +meet all of these conditions: + +a) You must cause the modified files to carry prominent notices stating that you +changed the files and the date of any change. + +b) You must cause any work that you distribute or publish, that in whole or in +part contains or is derived from the Program or any part thereof, to be licensed +as a whole at no charge to all third parties under the terms of this License. + +c) If the modified program normally reads commands interactively when run, you +must cause it, when started running for such interactive use in the most ordinary +way, to print or display an announcement including an appropriate copyright +notice and a notice that there is no warranty (or else, saying that you provide a +warranty) and that users may redistribute the program under these conditions, +and telling the user how to view a copy of this License. (Exception: if the +Program itself is interactive but does not normally print such an announcement, +your work based on the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If identifiable +sections of that work are not derived from the Program, and can be reasonably +considered independent and separate works in themselves, then this License, +and its terms, do not apply to those sections when you distribute them as +separate works. But when you distribute the same sections as part of a whole +which is a work based on the Program, the distribution of the whole must be on +the terms of this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest your rights to +work written entirely by you; rather, the intent is to exercise the right to control +the distribution of derivative or collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program with the +Program (or with a work based on the Program) on a volume of a storage or +distribution medium does not bring the other work under the scope of this +License. + +3. You may copy and distribute the Program (or a work based on it, under +Section 2) in object code or executable form under the terms of Sections 1 and 2 +above provided that you also do one of the following: + +a) Accompany it with the complete corresponding machine-readable source +code, which must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange; or, + +b) Accompany it with a written offer, valid for at least three years, to give any +third party, for a charge no more than your cost of physically performing source +distribution, a complete machine-readable copy of the corresponding source +code, to be distributed under the terms of Sections 1 and 2 above on a medium +customarily used for software interchange; or, + +c) Accompany it with the information you received as to the offer to distribute +corresponding source code. (This alternative is allowed only for noncommercial +distribution and only if you received the program in object code or executable +form with such an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for making +modifications to it. For an executable work, complete source code means all the +source code for all modules it contains, plus any associated interface definition +files, plus the scripts used to control compilation and installation of the +executable. However, as a special exception, the source code distributed need +not include anything that is normally distributed (in either source or binary form) +with the major components (compiler, kernel, and so on) of the operating system +on which the executable runs, unless that component itself accompanies the +executable. + +If distribution of executable or object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the source +code from the same place counts as distribution of the source code, even though +third parties are not compelled to copy the source along with the object code. + +4. You may not copy, modify, sublicense, or distribute the Program except as +expressly provided under this License. Any attempt otherwise to copy, modify, +sublicense or distribute the Program is void, and will automatically terminate +your rights under this License. However, parties who have received copies, or +rights, from you under this License will not have their licenses terminated so long +as such parties remain in full compliance. + +5. You are not required to accept this License, since you have not signed it. +However, nothing else grants you permission to modify or distribute the Program +or its derivative works. These actions are prohibited by law if you do not accept +this License. Therefore, by modifying or distributing the Program (or any work +based on the Program), you indicate your acceptance of this License to do so, +and all its terms and conditions for copying, distributing or modifying the +Program or works based on it. + +6. Each time you redistribute the Program (or any work based on the Program), +the recipient automatically receives a license from the original licensor to copy, +distribute or modify the Program subject to these terms and conditions. You +may not impose any further restrictions on the recipients' exercise of the rights +granted herein. You are not responsible for enforcing compliance by third parties +to this License. + +7. If, as a consequence of a court judgment or allegation of patent infringement +or for any other reason (not limited to patent issues), conditions are imposed on +you (whether by court order, agreement or otherwise) that contradict the +conditions of this License, they do not excuse you from the conditions of this +License. If you cannot distribute so as to satisfy simultaneously your obligations +under this License and any other pertinent obligations, then as a consequence +you may not distribute the Program at all. For example, if a patent license would +not permit royalty-free redistribution of the Program by all those who receive +copies directly or indirectly through you, then the only way you could satisfy +both it and this License would be to refrain entirely from distribution of the +Program. + +If any portion of this section is held invalid or unenforceable under any particular +circumstance, the balance of the section is intended to apply and the section as +a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any patents or other +property right claims or to contest validity of any such claims; this section has +the sole purpose of protecting the integrity of the free software distribution +system, which is implemented by public license practices. Many people have +made generous contributions to the wide range of software distributed through +that system in reliance on consistent application of that system; it is up to the +author/donor to decide if he or she is willing to distribute software through any +other system and a licensee cannot impose that choice. + +This section is intended to make thoroughly clear what is believed to be a +consequence of the rest of this License. + +8. If the distribution and/or use of the Program is restricted in certain countries +either by patents or by copyrighted interfaces, the original copyright holder who +places the Program under this License may add an explicit geographical +distribution limitation excluding those countries, so that distribution is permitted +only in or among countries not thus excluded. In such case, this License +incorporates the limitation as if written in the body of this License. + +9. The Free Software Foundation may publish revised and/or new versions of the +General Public License from time to time. Such new versions will be similar in +spirit to the present version, but may differ in detail to address new problems or +concerns. + +Each version is given a distinguishing version number. If the Program specifies a +version number of this License which applies to it and "any later version", you +have the option of following the terms and conditions either of that version or of +any later version published by the Free Software Foundation. If the Program does +not specify a version number of this License, you may choose any version ever +published by the Free Software Foundation. + +10. If you wish to incorporate parts of the Program into other free programs +whose distribution conditions are different, write to the author to ask for +permission. For software which is copyrighted by the Free Software Foundation, +write to the Free Software Foundation; we sometimes make exceptions for this. +Our decision will be guided by the two goals of preserving the free status of all +derivatives of our free software and of promoting the sharing and reuse of +software generally. + +NO WARRANTY + +11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS +NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE +COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM +"AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR +IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, +YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR +CORRECTION. + +12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED +TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY +WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS +PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM +(INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY +OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS +BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +END OF TERMS AND CONDITIONS + + +--------------------------------------------------------------------------- + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of the +package the right to use and distribute the Package in a more-or-less customary +fashion, plus the right to make reasonable modifications. + +Definitions: + +- "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through textual + modification. +- "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. +- "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. +- "You" is you, if you're thinking about copying or distributing this Package. +- "Reasonable copying fee" is whatever you can justify on the basis of + media cost, duplication charges, time of people involved, and so on. (You + will not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) +- "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you duplicate +all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived from +the Public Domain or from the Copyright Holder. A Package modified in such a +way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and when +you changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise + make them Freely Available, such as by posting said modifications + to Usenet or an equivalent medium, or placing the modifications on + a major archive site such as ftp.uu.net, or by allowing the + Copyright Holder to include your modifications in the Standard + Version of the Package. + + b) use the modified Package only within your corporation or + organization. + + c) rename any non-standard executables so the names do not + conflict with standard executables, which must also be provided, + and provide a separate manual page for each non-standard + executable that clearly documents how it differs from the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library + files, together with instructions (in the manual page or equivalent) + on where to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) accompany any non-standard executables with their + corresponding Standard Version executables, giving the + non-standard executables non-standard names, and clearly + documenting the differences in manual pages (or equivalent), + together with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this Package. +You may charge any fee you choose for support of this Package. You may not +charge a fee for this Package itself. However, you may distribute this Package in +aggregate with other (possibly commercial) programs as part of a larger +(possibly commercial) software distribution provided that you do not advertise +this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output from +the programs of this Package do not automatically fall under the copyright of this +Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. Aggregation of this Package with a commercial distribution is always permitted +provided that the use of this Package is embedded; that is, when no overt attempt +is made to make this Package's interfaces visible to the end user of the +commercial distribution. Such use shall not be construed as a distribution of +this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR +PURPOSE. + +The End + + diff --git a/CGI/README b/CGI/README new file mode 100644 index 000000000..1af8860c6 --- /dev/null +++ b/CGI/README @@ -0,0 +1,41 @@ +pod2text CGI::Perljax.pm > README + +CGI::Perljax + +Perljax - a perl-specific system for writing AJAX- or +DHTML-based web applications. + + +Perljax provides a unique mechanism for using perl code +asynchronously from javascript using AJAX to access user-written +perl functions/methods. Perljax unburdens the user from having to +write any javascript, except for having to associate an exported +method with a document-defined event (such as onClick, onKeyUp, +etc). Only in the more advanced implementations of a exported perl +method would a user need to write custom javascript. Perljax supports +methods that return single results, or multiple results to the web +page. No other projects that we know of are like Perljax for the +following reasons: 1. Perljax is targeted specifically for perl +development. 2. Perljax shields the user from having to write any +javascript at all (unless they want to). 3. The URL for the HTTP GET +request is automatically generated based on HTML layout and events, +and the page is then dynamically updated. 4. Perljax is not part +of a Content Management System, or some other larger project. + + +INSTALL + +perl Makefile.PL +make +make test +make install + +*If you are on a windows box you should use 'nmake' rather than 'make'. + +Installation will place Perljax into the system perl @INC path, but it +is important that you make sure mod_perl uses this path (which is +mod_perl's default behavior, and also assuming you use mod_perl, and +not just run perl as a CGI). + +Example scripts are provided in the source script directory, and can +also be seen on the project's website, http://www.perljax.us. diff --git a/SL/AM.pm b/SL/AM.pm index a06761c04..6249f54d6 100644 --- a/SL/AM.pm +++ b/SL/AM.pm @@ -37,6 +37,8 @@ package AM; +use Data::Dumper; + sub get_account { $main::lxdebug->enter_sub(); @@ -46,11 +48,12 @@ sub get_account { # connect to database my $dbh = $form->dbconnect($myconfig); + my $query = qq§SELECT c.accno, c.description, c.charttype, c.gifi_accno, + c.category,c.link, tk.taxkey_id, tk.pos_ustva, tk.tax_id,tk.tax_id||'--'||tk.taxkey_id AS tax, tk.startdate, c.pos_bilanz, c.pos_eur, c.new_chart_id, c.valid_from, c.pos_bwa + FROM chart c LEFT JOIN taxkeys tk + ON (c.id=tk.chart_id AND tk.id = (SELECT id from taxkeys where taxkeys.chart_id =c.id AND startdate<=current_date ORDER BY startdate desc LIMIT 1)) + WHERE c.id = $form->{id}§; - my $query = qq|SELECT c.accno, c.description, c.charttype, c.gifi_accno, - c.category, c.link, c.taxkey_id, c.pos_ustva, c.pos_bwa, c.pos_bilanz,c.pos_eur - FROM chart c - WHERE c.id = $form->{id}|; my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -76,19 +79,35 @@ sub get_account { $sth->finish; # get taxkeys and description - $query = qq|SELECT taxkey, taxdescription - FROM tax|; + $query = qq§SELECT id, taxkey,id||'--'||taxkey AS tax, taxdescription + FROM tax ORDER BY taxkey§; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - - $ref = $sth->fetchrow_hashref(NAME_lc); - + + $form->{TAXKEY} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { push @{ $form->{TAXKEY} }, $ref; } $sth->finish; + if ($form->{id}) { + $where = " WHERE link='$form->{link}'"; + + + # get new accounts + $query = qq|SELECT id, accno,description + FROM chart $where|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{NEWACCOUNT} }, $ref; + } + + $sth->finish; + } # check if we have any transactions $query = qq|SELECT a.trans_id FROM acc_trans a WHERE a.chart_id = $form->{id}|; @@ -99,6 +118,21 @@ sub get_account { $form->{orphaned} = !$form->{orphaned}; $sth->finish; + # check if new account is active + $form->{new_chart_valid} = 0; + if ($form->{new_chart_id}) { + $query = qq|SELECT current_date-valid_from FROM chart + WHERE id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($count) = $sth->fetchrow_array; + if ($count >=0) { + $form->{new_chart_valid} = 1; + } + $sth->finish; + } + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -145,9 +179,11 @@ sub save_account { } map({ $form->{$_} = "NULL" unless ($form->{$_}); } - qw(pos_ustva pos_bwa pos_bilanz pos_eur)); - - if ($form->{id}) { + qw(pos_ustva pos_bwa pos_bilanz pos_eur new_chart_id)); + my($tax_id, $taxkey) = split /--/, $form->{tax}; + $form->{valid_from} = ($form->{valid_from}) ? "'$form->{valid_from}'" : "NULL"; + my $startdate = ($form->{startdate}) ? "'$form->{startdate}'" : "'1970-01-01'"; + if ($form->{id} && $form->{orphaned}) { $query = qq|UPDATE chart SET accno = '$form->{accno}', description = '$form->{description}', @@ -155,65 +191,83 @@ sub save_account { gifi_accno = '$form->{gifi_accno}', category = '$form->{category}', link = '$form->{link}', - taxkey_id = $form->{taxkey_id}, + taxkey_id = $taxkey, pos_ustva = $form->{pos_ustva}, pos_bwa = $form->{pos_bwa}, pos_bilanz = $form->{pos_bilanz}, - pos_eur = $form->{pos_eur} + pos_eur = $form->{pos_eur}, + new_chart_id = $form->{new_chart_id}, + valid_from = $form->{valid_from} + WHERE id = $form->{id}|; + } elsif ($form->{id} && !$form->{new_chart_valid}) { + $query = qq|UPDATE chart SET + new_chart_id = $form->{new_chart_id}, + valid_from = $form->{valid_from} WHERE id = $form->{id}|; } else { $query = qq|INSERT INTO chart - (accno, description, charttype, gifi_accno, category, link, taxkey_id, pos_ustva, pos_bwa, pos_bilanz,pos_eur) + (accno, description, charttype, gifi_accno, category, link, taxkey_id, pos_ustva, pos_bwa, pos_bilanz,pos_eur, new_chart_id, valid_from) VALUES ('$form->{accno}', '$form->{description}', '$form->{charttype}', '$form->{gifi_accno}', - '$form->{category}', '$form->{link}', $form->{taxkey_id}, $form->{pos_ustva}, $form->{pos_bwa}, $form->{pos_bilanz}, $form->{pos_eur})|; + '$form->{category}', '$form->{link}', $taxkey, $form->{pos_ustva}, $form->{pos_bwa}, $form->{pos_bilanz}, $form->{pos_eur}, $form->{new_chart_id}, $form->{valid_from})|; } $dbh->do($query) || $form->dberror($query); - if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) { - - my $chart_id = $form->{id}; - - unless ($form->{id}) { - - # get id from chart - $query = qq|SELECT c.id - FROM chart c - WHERE c.accno = '$form->{accno}'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - ($chart_id) = $sth->fetchrow_array; - $sth->finish; - } - - # add account if it doesn't exist in tax - $query = qq|SELECT t.chart_id - FROM tax t - WHERE t.chart_id = $chart_id|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - my ($tax_id) = $sth->fetchrow_array; - $sth->finish; - - # add tax if it doesn't exist - unless ($tax_id) { - $query = qq|INSERT INTO tax (chart_id, rate) - VALUES ($chart_id, 0)|; - $dbh->do($query) || $form->dberror($query); - } + #Save Taxes + if (!$form->{id}) { + $query = qq|INSERT INTO taxkeys (chart_id,tax_id,taxkey_id, pos_ustva, startdate) VALUES ((SELECT id FROM chart where accno='$form->{accno}'), $tax_id, $taxkey,$form->{pos_ustva}, $startdate)|; + $dbh->do($query) || $form->dberror($query); } else { - - # remove tax - if ($form->{id}) { - $query = qq|DELETE FROM tax - WHERE chart_id = $form->{id}|; - $dbh->do($query) || $form->dberror($query); - } + $query = qq|DELETE FROM taxkeys WHERE chart_id=$form->{id} AND tax_id=$tax_id|; + $dbh->do($query) || $form->dberror($query); + $query = qq|INSERT INTO taxkeys (chart_id,tax_id,taxkey_id, pos_ustva, startdate) VALUES ($form->{id}, $tax_id, $taxkey,$form->{pos_ustva}, $startdate)|; + $dbh->do($query) || $form->dberror($query); } +# if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) { +# +# my $chart_id = $form->{id}; +# +# unless ($form->{id}) { +# +# # get id from chart +# $query = qq|SELECT c.id +# FROM chart c +# WHERE c.accno = '$form->{accno}'|; +# $sth = $dbh->prepare($query); +# $sth->execute || $form->dberror($query); +# +# ($chart_id) = $sth->fetchrow_array; +# $sth->finish; +# } +# +# # add account if it doesn't exist in tax +# $query = qq|SELECT t.chart_id +# FROM tax t +# WHERE t.chart_id = $chart_id|; +# $sth = $dbh->prepare($query); +# $sth->execute || $form->dberror($query); +# +# my ($tax_id) = $sth->fetchrow_array; +# $sth->finish; +# +# # add tax if it doesn't exist +# unless ($tax_id) { +# $query = qq|INSERT INTO tax (chart_id, rate) +# VALUES ($chart_id, 0)|; +# $dbh->do($query) || $form->dberror($query); +# } +# } else { +# +# # remove tax +# if ($form->{id}) { +# $query = qq|DELETE FROM tax +# WHERE chart_id = $form->{id}|; +# $dbh->do($query) || $form->dberror($query); +# } +# } + # commit my $rc = $dbh->commit; $dbh->disconnect; @@ -274,16 +328,527 @@ sub delete_account { $dbh->do($query) || $form->dberror($query); } - # commit and redirect - my $rc = $dbh->commit; + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); + + return $rc; +} + +sub gifi_accounts { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description + FROM gifi + ORDER BY accno|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_gifi { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT g.accno, g.description + FROM gifi g + WHERE g.accno = '$form->{accno}'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check for transactions + $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g + WHERE c.gifi_accno = g.accno + AND a.chart_id = c.id + AND g.accno = '$form->{accno}'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $sth->finish; + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_gifi { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/\'/\'\'/g; + + # id is the old account number! + if ($form->{id}) { + $query = qq|UPDATE gifi SET + accno = '$form->{accno}', + description = '$form->{description}' + WHERE accno = '$form->{id}'|; + } else { + $query = qq|INSERT INTO gifi + (accno, description) + VALUES ('$form->{accno}', '$form->{description}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub delete_gifi { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # id is the old account number! + $query = qq|DELETE FROM gifi + WHERE accno = '$form->{id}'|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub warehouses { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT id, description + FROM warehouse + ORDER BY 2|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_warehouse { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT w.description + FROM warehouse w + WHERE w.id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # see if it is in use + $query = qq|SELECT count(*) FROM inventory i + WHERE i.warehouse_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + $sth->finish; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_warehouse { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/\'/\'\'/g; + + if ($form->{id}) { + $query = qq|UPDATE warehouse SET + description = '$form->{description}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO warehouse + (description) + VALUES ('$form->{description}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub delete_warehouse { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM warehouse + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub departments { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT d.id, d.description, d.role + FROM department d + ORDER BY 2|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_department { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT d.description, d.role + FROM department d + WHERE d.id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # see if it is in use + $query = qq|SELECT count(*) FROM dpt_trans d + WHERE d.department_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + $sth->finish; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_department { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/\'/\'\'/g; + + if ($form->{id}) { + $query = qq|UPDATE department SET + description = '$form->{description}', + role = '$form->{role}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO department + (description, role) + VALUES ('$form->{description}', '$form->{role}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub delete_department { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM department + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub lead { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT id, lead + FROM leads + ORDER BY 2|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_lead { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = + qq|SELECT l.id, l.lead + FROM leads l + WHERE l.id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_lead { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{lead} =~ s/\'/\'\'/g; + + # id is the old record + if ($form->{id}) { + $query = qq|UPDATE leads SET + lead = '$form->{description}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO leads + (lead) + VALUES ('$form->{description}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub delete_lead { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM leads + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub business { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT id, description, discount, customernumberinit, salesman + FROM business + ORDER BY 2|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_business { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = + qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman + FROM business b + WHERE b.id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_business { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/\'/\'\'/g; + $form->{discount} /= 100; + $form->{salesman} *= 1; + + # id is the old record + if ($form->{id}) { + $query = qq|UPDATE business SET + description = '$form->{description}', + discount = $form->{discount}, + customernumberinit = '$form->{customernumberinit}', + salesman = '$form->{salesman}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO business + (description, discount, customernumberinit, salesman) + VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub delete_business { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM business + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + $dbh->disconnect; $main::lxdebug->leave_sub(); - - return $rc; } -sub gifi_accounts { + +sub language { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -291,9 +856,9 @@ sub gifi_accounts { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT accno, description - FROM gifi - ORDER BY accno|; + my $query = qq|SELECT id, description, template_code, article_code + FROM language + ORDER BY 2|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -308,7 +873,7 @@ sub gifi_accounts { $main::lxdebug->leave_sub(); } -sub get_gifi { +sub get_language { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -316,9 +881,10 @@ sub get_gifi { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT g.accno, g.description - FROM gifi g - WHERE g.accno = '$form->{accno}'|; + my $query = + qq|SELECT l.description, l.template_code, l.article_code + FROM language l + WHERE l.id = $form->{id}|; my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -328,24 +894,12 @@ sub get_gifi { $sth->finish; - # check for transactions - $query = qq|SELECT count(*) FROM acc_trans a, chart c, gifi g - WHERE c.gifi_accno = g.accno - AND a.chart_id = c.id - AND g.accno = '$form->{accno}'|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - ($form->{orphaned}) = $sth->fetchrow_array; - $sth->finish; - $form->{orphaned} = !$form->{orphaned}; - $dbh->disconnect; $main::lxdebug->leave_sub(); } -sub save_gifi { +sub save_language { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -354,17 +908,21 @@ sub save_gifi { my $dbh = $form->dbconnect($myconfig); $form->{description} =~ s/\'/\'\'/g; + $form->{article_code} =~ s/\'/\'\'/g; + $form->{template_code} =~ s/\'/\'\'/g; - # id is the old account number! + + # id is the old record if ($form->{id}) { - $query = qq|UPDATE gifi SET - accno = '$form->{accno}', - description = '$form->{description}' - WHERE accno = '$form->{id}'|; + $query = qq|UPDATE language SET + description = '$form->{description}', + template_code = '$form->{template_code}', + article_code = '$form->{article_code}' + WHERE id = $form->{id}|; } else { - $query = qq|INSERT INTO gifi - (accno, description) - VALUES ('$form->{accno}', '$form->{description}')|; + $query = qq|INSERT INTO language + (description, template_code, article_code) + VALUES ('$form->{description}', '$form->{template_code}', '$form->{article_code}')|; } $dbh->do($query) || $form->dberror($query); @@ -373,7 +931,7 @@ sub save_gifi { $main::lxdebug->leave_sub(); } -sub delete_gifi { +sub delete_language { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -381,9 +939,8 @@ sub delete_gifi { # connect to database my $dbh = $form->dbconnect($myconfig); - # id is the old account number! - $query = qq|DELETE FROM gifi - WHERE accno = '$form->{id}'|; + $query = qq|DELETE FROM language + WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); $dbh->disconnect; @@ -391,7 +948,8 @@ sub delete_gifi { $main::lxdebug->leave_sub(); } -sub warehouses { + +sub buchungsgruppe { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -399,9 +957,9 @@ sub warehouses { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT id, description - FROM warehouse - ORDER BY 2|; + my $query = qq|SELECT id, description, inventory_accno_id, (select accno from chart where id=inventory_accno_id) as inventory_accno, income_accno_id_0, (select accno from chart where id=income_accno_id_0) as income_accno_0, expense_accno_id_0, (select accno from chart where id=expense_accno_id_0) as expense_accno_0, income_accno_id_1, (select accno from chart where id=income_accno_id_1) as income_accno_1, expense_accno_id_1, (select accno from chart where id=expense_accno_id_1) as expense_accno_1, income_accno_id_2, (select accno from chart where id=income_accno_id_2) as income_accno_2, expense_accno_id_2, (select accno from chart where id=expense_accno_id_2) as expense_accno_2, income_accno_id_3, (select accno from chart where id=income_accno_id_3) as income_accno_3, expense_accno_id_3, (select accno from chart where id=expense_accno_id_3) as expense_accno_3 + FROM buchungsgruppen + ORDER BY id|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -416,7 +974,7 @@ sub warehouses { $main::lxdebug->leave_sub(); } -sub get_warehouse { +sub get_buchungsgruppe { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -424,34 +982,81 @@ sub get_warehouse { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT w.description - FROM warehouse w - WHERE w.id = $form->{id}|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + if ($form->{id}) { + my $query = + qq|SELECT description, inventory_accno_id, (select accno from chart where id=inventory_accno_id) as inventory_accno, income_accno_id_0, (select accno from chart where id=income_accno_id_0) as income_accno_0, expense_accno_id_0, (select accno from chart where id=expense_accno_id_0) as expense_accno_0, income_accno_id_1, (select accno from chart where id=income_accno_id_1) as income_accno_1, expense_accno_id_1, (select accno from chart where id=expense_accno_id_1) as expense_accno_1, income_accno_id_2, (select accno from chart where id=income_accno_id_2) as income_accno_2, expense_accno_id_2, (select accno from chart where id=expense_accno_id_2) as expense_accno_2, income_accno_id_3, (select accno from chart where id=income_accno_id_3) as income_accno_3, expense_accno_id_3, (select accno from chart where id=expense_accno_id_3) as expense_accno_3 + FROM buchungsgruppen + WHERE id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + my $query = + qq|SELECT count(id) as anzahl + FROM parts + WHERE buchungsgruppen_id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + if (!$ref->{anzahl}) { + $form->{orphaned} = 1; + } + $sth->finish; - my $ref = $sth->fetchrow_hashref(NAME_lc); + } - map { $form->{$_} = $ref->{$_} } keys %$ref; + $query = "SELECT inventory_accno_id FROM defaults"; + ($form->{"std_inventory_accno_id"}) = $dbh->selectrow_array($query); - $sth->finish; + my $module = "IC"; + $query = qq|SELECT c.accno, c.description, c.link, c.id, + d.inventory_accno_id, d.income_accno_id, d.expense_accno_id + FROM chart c, defaults d + WHERE c.link LIKE '%$module%' + ORDER BY c.accno|; - # see if it is in use - $query = qq|SELECT count(*) FROM inventory i - WHERE i.warehouse_id = $form->{id}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - ($form->{orphaned}) = $sth->fetchrow_array; - $form->{orphaned} = !$form->{orphaned}; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $key (split(/:/, $ref->{link})) { + if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) { + $form->{"std_inventory_accno_id"} = $ref->{"id"}; + } + if ($key =~ /$module/) { + if ( ($ref->{id} eq $ref->{inventory_accno_id}) + || ($ref->{id} eq $ref->{income_accno_id}) + || ($ref->{id} eq $ref->{expense_accno_id})) { + push @{ $form->{"${module}_links"}{$key} }, + { accno => $ref->{accno}, + description => $ref->{description}, + selected => "selected", + id => $ref->{id} }; + } else { + push @{ $form->{"${module}_links"}{$key} }, + { accno => $ref->{accno}, + description => $ref->{description}, + selected => "", + id => $ref->{id} }; + } + } + } + } $sth->finish; + $dbh->disconnect; $main::lxdebug->leave_sub(); } -sub save_warehouse { +sub save_buchungsgruppe { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -461,14 +1066,25 @@ sub save_warehouse { $form->{description} =~ s/\'/\'\'/g; + + # id is the old record if ($form->{id}) { - $query = qq|UPDATE warehouse SET - description = '$form->{description}' + $query = qq|UPDATE buchungsgruppen SET + description = '$form->{description}', + inventory_accno_id = '$form->{inventory_accno_id}', + income_accno_id_0 = '$form->{income_accno_id_0}', + expense_accno_id_0 = '$form->{expense_accno_id_0}', + income_accno_id_1 = '$form->{income_accno_id_1}', + expense_accno_id_1 = '$form->{expense_accno_id_1}', + income_accno_id_2 = '$form->{income_accno_id_2}', + expense_accno_id_2 = '$form->{expense_accno_id_2}', + income_accno_id_3 = '$form->{income_accno_id_3}', + expense_accno_id_3 = '$form->{expense_accno_id_3}' WHERE id = $form->{id}|; } else { - $query = qq|INSERT INTO warehouse - (description) - VALUES ('$form->{description}')|; + $query = qq|INSERT INTO buchungsgruppen + (description, inventory_accno_id, income_accno_id_0, expense_accno_id_0, income_accno_id_1, expense_accno_id_1, income_accno_id_2, expense_accno_id_2, income_accno_id_3, expense_accno_id_3) + VALUES ('$form->{description}', '$form->{inventory_accno_id}', '$form->{income_accno_id_0}', '$form->{expense_accno_id_0}', '$form->{income_accno_id_1}', '$form->{expense_accno_id_1}', '$form->{income_accno_id_2}', '$form->{expense_accno_id_2}', '$form->{income_accno_id_3}', '$form->{expense_accno_id_3}')|; } $dbh->do($query) || $form->dberror($query); @@ -477,7 +1093,7 @@ sub save_warehouse { $main::lxdebug->leave_sub(); } -sub delete_warehouse { +sub delete_buchungsgruppe { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -485,7 +1101,7 @@ sub delete_warehouse { # connect to database my $dbh = $form->dbconnect($myconfig); - $query = qq|DELETE FROM warehouse + $query = qq|DELETE FROM buchungsgruppen WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); @@ -494,7 +1110,7 @@ sub delete_warehouse { $main::lxdebug->leave_sub(); } -sub departments { +sub printer { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -502,8 +1118,8 @@ sub departments { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT d.id, d.description, d.role - FROM department d + my $query = qq|SELECT id, printer_description, template_code, printer_command + FROM printers ORDER BY 2|; $sth = $dbh->prepare($query); @@ -519,7 +1135,7 @@ sub departments { $main::lxdebug->leave_sub(); } -sub get_department { +sub get_printer { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -527,9 +1143,10 @@ sub get_department { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT d.description, d.role - FROM department d - WHERE d.id = $form->{id}|; + my $query = + qq|SELECT p.printer_description, p.template_code, p.printer_command + FROM printers p + WHERE p.id = $form->{id}|; my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -539,22 +1156,12 @@ sub get_department { $sth->finish; - # see if it is in use - $query = qq|SELECT count(*) FROM dpt_trans d - WHERE d.department_id = $form->{id}|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - ($form->{orphaned}) = $sth->fetchrow_array; - $form->{orphaned} = !$form->{orphaned}; - $sth->finish; - $dbh->disconnect; $main::lxdebug->leave_sub(); } -sub save_department { +sub save_printer { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -562,17 +1169,22 @@ sub save_department { # connect to database my $dbh = $form->dbconnect($myconfig); - $form->{description} =~ s/\'/\'\'/g; + $form->{printer_description} =~ s/\'/\'\'/g; + $form->{printer_command} =~ s/\'/\'\'/g; + $form->{template_code} =~ s/\'/\'\'/g; + + # id is the old record if ($form->{id}) { - $query = qq|UPDATE department SET - description = '$form->{description}', - role = '$form->{role}' + $query = qq|UPDATE printers SET + printer_description = '$form->{printer_description}', + template_code = '$form->{template_code}', + printer_command = '$form->{printer_command}' WHERE id = $form->{id}|; } else { - $query = qq|INSERT INTO department - (description, role) - VALUES ('$form->{description}', '$form->{role}')|; + $query = qq|INSERT INTO printers + (printer_description, template_code, printer_command) + VALUES ('$form->{printer_description}', '$form->{template_code}', '$form->{printer_command}')|; } $dbh->do($query) || $form->dberror($query); @@ -581,7 +1193,7 @@ sub save_department { $main::lxdebug->leave_sub(); } -sub delete_department { +sub delete_printer { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -589,7 +1201,7 @@ sub delete_department { # connect to database my $dbh = $form->dbconnect($myconfig); - $query = qq|DELETE FROM department + $query = qq|DELETE FROM printers WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); @@ -598,7 +1210,7 @@ sub delete_department { $main::lxdebug->leave_sub(); } -sub business { +sub payment { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -606,14 +1218,15 @@ sub business { # connect to database my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT id, description, discount, customernumberinit, salesman - FROM business - ORDER BY 2|; + my $query = qq|SELECT * + FROM payment_terms + ORDER BY id|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{percent_skonto} = $form->format_amount($myconfig,($ref->{percent_skonto} * 100)); push @{ $form->{ALL} }, $ref; } @@ -623,7 +1236,7 @@ sub business { $main::lxdebug->leave_sub(); } -sub get_business { +sub get_payment { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -632,13 +1245,14 @@ sub get_business { my $dbh = $form->dbconnect($myconfig); my $query = - qq|SELECT b.description, b.discount, b.customernumberinit, b.salesman - FROM business b - WHERE b.id = $form->{id}|; + qq|SELECT * + FROM payment_terms + WHERE id = $form->{id}|; my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); my $ref = $sth->fetchrow_hashref(NAME_lc); + $ref->{percent_skonto} = $form->format_amount($myconfig,($ref->{percent_skonto} * 100)); map { $form->{$_} = $ref->{$_} } keys %$ref; @@ -649,7 +1263,7 @@ sub get_business { $main::lxdebug->leave_sub(); } -sub save_business { +sub save_payment { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -658,21 +1272,29 @@ sub save_business { my $dbh = $form->dbconnect($myconfig); $form->{description} =~ s/\'/\'\'/g; - $form->{discount} /= 100; - $form->{salesman} *= 1; + $form->{description_long} =~ s/\'/\'\'/g; + $percentskonto = $form->parse_amount($myconfig, $form->{percent_skonto}) /100; + $form->{ranking} *= 1; + $form->{terms_netto} *= 1; + $form->{terms_skonto} *= 1; + $form->{percent_skonto} *= 1; + + # id is the old record if ($form->{id}) { - $query = qq|UPDATE business SET + $query = qq|UPDATE payment_terms SET description = '$form->{description}', - discount = $form->{discount}, - customernumberinit = '$form->{customernumberinit}', - salesman = '$form->{salesman}' + ranking = $form->{ranking}, + description_long = '$form->{description_long}', + terms_netto = $form->{terms_netto}, + terms_skonto = $form->{terms_skonto}, + percent_skonto = $percentskonto WHERE id = $form->{id}|; } else { - $query = qq|INSERT INTO business - (description, discount, customernumberinit, salesman) - VALUES ('$form->{description}', $form->{discount}, '$form->{customernumberinit}', '$form->{salesman}')|; + $query = qq|INSERT INTO payment_terms + (description, ranking, description_long, terms_netto, terms_skonto, percent_skonto) + VALUES ('$form->{description}', $form->{ranking}, '$form->{description_long}', $form->{terms_netto}, $form->{terms_skonto}, $percentskonto)|; } $dbh->do($query) || $form->dberror($query); @@ -681,7 +1303,7 @@ sub save_business { $main::lxdebug->leave_sub(); } -sub delete_business { +sub delete_payment { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; @@ -689,7 +1311,7 @@ sub delete_business { # connect to database my $dbh = $form->dbconnect($myconfig); - $query = qq|DELETE FROM business + $query = qq|DELETE FROM payment_terms WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); @@ -832,12 +1454,12 @@ sub save_preferences { my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_; - map { ($form->{$_}) = split /--/, $form->{$_} } + map { ($form->{$_}) = split(/--/, $form->{$_}) } qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno); my @a; $form->{curr} =~ s/ //g; - map { push(@a, uc pack "A3", $_) if $_ } split /:/, $form->{curr}; + map { push(@a, uc pack "A3", $_) if $_ } split(/:/, $form->{curr}); $form->{curr} = join ':', @a; # connect to database @@ -863,6 +1485,7 @@ sub save_preferences { (SELECT c.id FROM chart c WHERE c.accno = '$form->{fxloss_accno}'), invnumber = '$form->{invnumber}', + cnnumber = '$form->{cnnumber}', sonumber = '$form->{sonumber}', ponumber = '$form->{ponumber}', sqnumber = '$form->{sqnumber}', @@ -886,13 +1509,13 @@ sub save_preferences { WHERE login = '$form->{login}'|; $dbh->do($query) || $form->dberror($query); - foreach my $item (split / /, $form->{taxaccounts}) { - $query = qq|UPDATE tax - SET rate = | . ($form->{$item} / 100) . qq|, - taxnumber = '$form->{"taxnumber_$item"}' - WHERE chart_id = $item|; - $dbh->do($query) || $form->dberror($query); - } +# foreach my $item (split(/ /, $form->{taxaccounts})) { +# $query = qq|UPDATE tax +# SET rate = | . ($form->{$item} / 100) . qq|, +# taxnumber = '$form->{"taxnumber_$item"}' +# WHERE chart_id = $item|; +# $dbh->do($query) || $form->dberror($query); +# } my $rc = $dbh->commit; $dbh->disconnect; @@ -1335,16 +1958,14 @@ sub closebooks { $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '1'|; - } else { - if ($form->{closedto}) { + } elsif ($form->{closedto}) { - $query = qq|UPDATE defaults SET closedto = '$form->{closedto}', + $query = qq|UPDATE defaults SET closedto = '$form->{closedto}', revtrans = '0'|; - } else { + } else { - $query = qq|UPDATE defaults SET closedto = NULL, + $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '0'|; - } } # set close in defaults @@ -1355,4 +1976,197 @@ sub closebooks { $main::lxdebug->leave_sub(); } +sub get_base_unit { + my ($self, $units, $unit_name, $factor) = @_; + + $factor = 1 unless ($factor); + + my $unit = $units->{$unit_name}; + + if (!defined($unit) || !$unit->{"base_unit"} || + ($unit_name eq $unit->{"base_unit"})) { + return ($unit_name, $factor); + } + + return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"}); +} + +sub retrieve_units { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $type, $prefix) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query = "SELECT *, base_unit AS original_base_unit FROM units"; + my @values; + if ($type) { + $query .= " WHERE (type = ?)"; + @values = ($type); + } + + my $sth = $dbh->prepare($query); + $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")"); + + my $units = {}; + while (my $ref = $sth->fetchrow_hashref()) { + $units->{$ref->{"name"}} = $ref; + } + $sth->finish(); + + foreach my $unit (keys(%{$units})) { + ($units->{$unit}->{"${prefix}base_unit"}, $units->{$unit}->{"${prefix}factor"}) = AM->get_base_unit($units, $unit); + } + + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $units; +} + +sub units_in_use { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $units) = @_; + + my $dbh = $form->dbconnect($myconfig); + + foreach my $unit (values(%{$units})) { + my $base_unit = $unit->{"original_base_unit"}; + while ($base_unit) { + $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"}); + push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"}); + $base_unit = $units->{$base_unit}->{"original_base_unit"}; + } + } + + foreach my $unit (values(%{$units})) { + $unit->{"in_use"} = 0; + map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}}); + + foreach my $table (qw(parts invoice orderitems)) { + my $query = "SELECT COUNT(*) FROM $table WHERE unit "; + + if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) { + $query .= "= " . $dbh->quote($unit->{"name"}); + } else { + $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," . join(",", @{$unit->{"DEPENDING_UNITS"}}) . ")"; + } + + my ($count) = $dbh->selectrow_array($query); + $form->dberror($query) if ($dbh->err); + + if ($count) { + $unit->{"in_use"} = 1; + last; + } + } + } + + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); +} + +sub unit_select_data { + $main::lxdebug->enter_sub(); + + my ($self, $units, $selected, $empty_entry) = @_; + + my $select = []; + + if ($empty_entry) { + push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" }); + } + + foreach my $unit (sort({ lc($a) cmp lc($b) } keys(%{$units}))) { + push(@{$select}, { "name" => $unit, + "base_unit" => $units->{$unit}->{"base_unit"}, + "factor" => $units->{$unit}->{"factor"}, + "selected" => ($unit eq $selected) ? "selected" : "" }); + } + + $main::lxdebug->leave_sub(); + + return $select; +} + +sub unit_select_html { + $main::lxdebug->enter_sub(); + + my ($self, $units, $name, $selected, $convertible_into) = @_; + + my $select = ""; + + $main::lxdebug->leave_sub(); + + return $select; +} + +sub add_unit { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $name, $base_unit, $factor, $type) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query = "INSERT INTO units (name, base_unit, factor, type) VALUES (?, ?, ?, ?)"; + $dbh->do($query, undef, $name, $base_unit, $factor, $type) || $form->dberror($query . " ($name, $base_unit, $factor, $type)"); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); +} + +sub save_units { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $type, $units, $delete_units) = @_; + + my $dbh = $form->dbconnect_noauto($myconfig); + + my ($base_unit, $unit, $sth, $query); + + if ($delete_units && (0 != scalar(@{$delete_units}))) { + $query = "DELETE FROM units WHERE name = ?"; + $sth = $dbh->prepare($query); + map({ $sth->execute($_) || $form->dberror($query . " ($_)"); } @{$delete_units}); + $sth->finish(); + } + + $query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?"; + $sth = $dbh->prepare($query); + + foreach $unit (values(%{$units})) { + $unit->{"depth"} = 0; + my $base_unit = $unit; + while ($base_unit->{"base_unit"}) { + $unit->{"depth"}++; + $base_unit = $units->{$base_unit->{"base_unit"}}; + } + } + + foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) { + next if ($unit->{"unchanged_unit"}); + + my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"}); + $sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")"); + } + + $sth->finish(); + $dbh->commit(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); +} + 1; diff --git a/SL/AP.pm b/SL/AP.pm index e909890f8..b0e044032 100644 --- a/SL/AP.pm +++ b/SL/AP.pm @@ -76,6 +76,9 @@ sub post_transaction { $form->{exchangerate} * -1, 2); $amount += ($form->{"amount_$i"} * -1); + + # parse tax_$i for later + $form->{"tax_$i"} = $form->parse_amount($myconfig, $form->{"tax_$i"}) * -1; } # this is for ap @@ -85,34 +88,42 @@ sub post_transaction { $form->{taxincluded} = 0 if ($form->{amount} == 0); for $i (1 .. $form->{rowcount}) { - ($form->{"taxkey_$i"}, $NULL) = split /--/, $form->{"taxchart_$i"}; + ($form->{"tax_id_$i"}, $NULL) = split /--/, $form->{"taxchart_$i"}; - $query = - qq| SELECT c.accno, t.rate FROM chart c, tax t where c.id=t.chart_id AND t.taxkey=$form->{"taxkey_$i"}|; + $query = qq|SELECT c.accno, t.taxkey, t.rate + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id=$form->{"tax_id_$i"} + ORDER BY c.accno|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - ($form->{AP_amounts}{"tax_$i"}, $form->{"taxrate_$i"}) = + ($form->{AP_amounts}{"tax_$i"}, $form->{"taxkey_$i"}, $form->{"taxrate_$i"}) = $sth->fetchrow_array; $form->{AP_amounts}{"tax_$i"}{taxkey} = $form->{"taxkey_$i"}; $form->{AP_amounts}{"amount_$i"}{taxkey} = $form->{"taxkey_$i"}; $sth->finish; - if (!$form->{"korrektur_$i"}) { - if ($form->{taxincluded} *= 1) { + if ($form->{taxincluded} *= 1) { + if (!$form->{"korrektur_$i"}) { $tax = $form->{"amount_$i"} - ($form->{"amount_$i"} / ($form->{"taxrate_$i"} + 1)); - $amount = $form->{"amount_$i"} - $tax; - $form->{"amount_$i"} = $form->round_amount($amount, 2); - $diff += $amount - $form->{"amount_$i"}; - $form->{"tax_$i"} = $form->round_amount($tax, 2); - $form->{netamount} += $form->{"amount_$i"}; } else { + $tax = $form->{"tax_$i"}; + } + $amount = $form->{"amount_$i"} - $tax; + $form->{"amount_$i"} = $form->round_amount($amount, 2); + $diff += $amount - $form->{"amount_$i"}; + $form->{"tax_$i"} = $form->round_amount($tax, 2); + $form->{netamount} += $form->{"amount_$i"}; + } else { + if (!$form->{"korrektur_$i"}) { $form->{"tax_$i"} = $form->{"amount_$i"} * $form->{"taxrate_$i"}; - $form->{"tax_$i"} = - $form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2); - $form->{netamount} += $form->{"amount_$i"}; + } else { + $tax = $form->{"tax_$i"}; } + $form->{"tax_$i"} = + $form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2); + $form->{netamount} += $form->{"amount_$i"}; } $form->{total_tax} += $form->{"tax_$i"} * -1; } diff --git a/SL/AR.pm b/SL/AR.pm index 42f8c1cc7..b4c0ae14d 100644 --- a/SL/AR.pm +++ b/SL/AR.pm @@ -91,35 +91,43 @@ sub post_transaction { $form->{taxincluded} = 0 if ($form->{amount} == 0); for $i (1 .. $form->{rowcount}) { - ($form->{"taxkey_$i"}, $NULL) = split /--/, $form->{"taxchart_$i"}; + ($form->{"tax_id_$i"}, $NULL) = split /--/, $form->{"taxchart_$i"}; + + $query = qq|SELECT c.accno, t.taxkey, t.rate + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id=$form->{"tax_id_$i"} + ORDER BY c.accno|; - $query = - qq| SELECT c.accno, t.rate FROM chart c, tax t where c.id=t.chart_id AND t.taxkey=$form->{"taxkey_$i"}|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - ($form->{AR_amounts}{"tax_$i"}, $form->{"taxrate_$i"}) = + ($form->{AR_amounts}{"tax_$i"}, $form->{"taxkey_$i"}, $form->{"taxrate_$i"}) = $sth->fetchrow_array; $form->{AR_amounts}{"tax_$i"}{taxkey} = $form->{"taxkey_$i"}; $form->{AR_amounts}{"amount_$i"}{taxkey} = $form->{"taxkey_$i"}; $sth->finish; - if (!$form->{"korrektur_$i"}) { - if ($form->{taxincluded} *= 1) { - $tax = - $form->{"amount_$i"} - - ($form->{"amount_$i"} / ($form->{"taxrate_$i"} + 1)); - $amount = $form->{"amount_$i"} - $tax; - $form->{"amount_$i"} = $form->round_amount($amount, 2); - $diff += $amount - $form->{"amount_$i"}; - $form->{"tax_$i"} = $form->round_amount($tax, 2); - $form->{netamount} += $form->{"amount_$i"}; + if ($form->{taxincluded} *= 1) { + if (!$form->{"korrektur_$i"}) { + $tax = + $form->{"amount_$i"} - + ($form->{"amount_$i"} / ($form->{"taxrate_$i"} + 1)); } else { + $tax = $form->{"tax_$i"}; + } + $amount = $form->{"amount_$i"} - $tax; + $form->{"amount_$i"} = $form->round_amount($amount, 2); + $diff += $amount - $form->{"amount_$i"}; + $form->{"tax_$i"} = $form->round_amount($tax, 2); + $form->{netamount} += $form->{"amount_$i"}; + } else { + if (!$form->{"korrektur_$i"}) { $form->{"tax_$i"} = $form->{"amount_$i"} * $form->{"taxrate_$i"}; - $form->{"tax_$i"} = - $form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2); - $form->{netamount} += $form->{"amount_$i"}; } + $form->{"tax_$i"} = + $form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2); + $form->{netamount} += $form->{"amount_$i"}; } + $form->{total_tax} += $form->{"tax_$i"}; } diff --git a/SL/BP.pm b/SL/BP.pm index e77695426..266679575 100644 --- a/SL/BP.pm +++ b/SL/BP.pm @@ -180,8 +180,10 @@ sub get_spoolfiles { $query .= " AND lower(a.quonumber) LIKE '$quonumber'"; } - # $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; - # $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + if ($form->{type} =~ /(invoice|sales_order|sales_quotation|packing_list|puchase_order|request_quotation)$/) { + $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + } my @a = (transdate, $invnumber, name); my $sortorder = join ', ', $form->sort_columns(@a); diff --git a/SL/CA.pm b/SL/CA.pm index 4453a9fd6..28ffc2e73 100644 --- a/SL/CA.pm +++ b/SL/CA.pm @@ -141,6 +141,7 @@ sub all_transactions { if ($form->{todate}) { $fromto .= " AND ac.transdate <= '$form->{todate}'"; $subwhere .= " AND transdate <= '$form->{todate}'"; + $glwhere .= " AND ac.transdate <= '$form->{todate}'"; } if ($form->{eur}) { diff --git a/SL/CP.pm b/SL/CP.pm index 341510c55..b411b0608 100644 --- a/SL/CP.pm +++ b/SL/CP.pm @@ -370,10 +370,17 @@ sub process_payment { $pth->finish; $amount += $form->{"paid_$i"}; + + # BUG 324 + if ($form->{arap} eq 'ap') { + $paid = "paid = paid + $amount"; + } else { + $paid = "paid = $amount"; + } # update AR/AP transaction $query = qq|UPDATE $form->{arap} set - paid = $amount, + $paid, datepaid = '$form->{datepaid}' WHERE id = $form->{"id_$i"}|; $dbh->do($query) || $form->dberror($query); diff --git a/SL/CT.pm b/SL/CT.pm index ab5d70ef4..f5729927e 100644 --- a/SL/CT.pm +++ b/SL/CT.pm @@ -36,6 +36,8 @@ #====================================================================== package CT; +use Data::Dumper; + sub get_tuple { $main::lxdebug->enter_sub(); @@ -43,10 +45,9 @@ sub get_tuple { my ($self, $myconfig, $form) = @_; my $dbh = $form->dbconnect($myconfig); - my $query = qq|SELECT ct.*, b.id AS business, s.*, cp.* + my $query = qq|SELECT ct.*, b.id AS business, cp.* FROM $form->{db} ct LEFT JOIN business b on ct.business_id = b.id - LEFT JOIN shipto s on ct.id = s.trans_id LEFT JOIN contacts cp on ct.id = cp.cp_cv_id WHERE ct.id = $form->{id} order by cp.cp_id limit 1|; my $sth = $dbh->prepare($query); @@ -131,6 +132,68 @@ sub get_tuple { } $sth->finish; + # get tax zones + $query = qq|SELECT id, description + FROM tax_zones|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{TAXZONE} }, $ref; + } + $sth->finish; + + + # get shipto address + $query = qq|SELECT shipto_id, shiptoname, shiptodepartment_1 + FROM shipto WHERE trans_id=$form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{SHIPTO} }, $ref; + } + $sth->finish; + + + # get contacts + $query = qq|SELECT cp_id, cp_name + FROM contacts WHERE cp_cv_id=$form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{CONTACTS} }, $ref; + } + $sth->finish; + + # get languages + $query = qq|SELECT id, description + FROM language + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{languages} }, $ref; + } + $sth->finish; + + # get languages + $query = qq|SELECT id, description + FROM payment_terms + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{payment_terms} }, $ref; + } + $sth->finish; + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -159,6 +222,20 @@ sub query_titles_and_greetings { %tmp = (); + $query = + "SELECT greeting FROM customer UNION select greeting FROM vendor"; + $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + next unless ($ref->{greeting} =~ /[a-zA-Z]/); + $tmp{ $ref->{greeting} } = 1; + } + $sth->finish(); + + @{ $form->{COMPANY_GREETINGS} } = sort(keys(%tmp)); + + %tmp = (); + $query = "SELECT DISTINCT(c.cp_title) FROM contacts c WHERE c.cp_title LIKE '%'"; $sth = $dbh->prepare($query); @@ -171,6 +248,19 @@ sub query_titles_and_greetings { @{ $form->{TITLES} } = sort(keys(%tmp)); + %tmp = (); + + $query = + "SELECT DISTINCT(c.cp_abteilung) FROM contacts c WHERE c.cp_abteilung LIKE '%'"; + $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $tmp{ $ref->{cp_abteilung} } = 1; + } + $sth->finish(); + + @{ $form->{DEPARTMENT} } = sort(keys(%tmp)); + $dbh->disconnect(); $main::lxdebug->leave_sub(); } @@ -210,6 +300,42 @@ sub taxaccounts { push @{ $form->{all_business} }, $ref; } $sth->finish; + # get languages + $query = qq|SELECT id, description + FROM language + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{languages} }, $ref; + } + $sth->finish; + + # get payment terms + $query = qq|SELECT id, description + FROM payment_terms + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{payment_terms} }, $ref; + } + $sth->finish; + + # get taxkeys and description + $query = qq|SELECT id, description + FROM tax_zones|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{TAXZONE} }, $ref; + } + $sth->finish; + $dbh->disconnect; @@ -231,8 +357,9 @@ sub save_customer { map({ $form->{"cp_${_}"} = $form->{"selected_cp_${_}"} if ($form->{"selected_cp_${_}"}); - } qw(title greeting)); - + } qw(title greeting abteilung)); + $form->{"greeting"} = $form->{"selected_company_greeting"} + if ($form->{"selected_company_greeting"}); # # escape ' map { $form->{$_} =~ s/\'/\'\'/g } @@ -246,24 +373,59 @@ sub save_customer { $form->{obsolete} *= 1; $form->{business} *= 1; $form->{salesman_id} *= 1; + $form->{language_id} *= 1; + $form->{payment_id} *= 1; + $form->{taxzone_id} *= 1; $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit}); - my ($query, $sth); + my ($query, $sth, $f_id); if ($form->{id}) { + + $query = qq|SELECT id FROM customer + WHERE customernumber = '$form->{customernumber}'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + (${f_id}) = $sth->fetchrow_array; + $sth->finish; + if ((${f_id} ne $form->{id}) and (${f_id} ne "")) { + + $main::lxdebug->leave_sub(); + return 3; + } $query = qq|DELETE FROM customertax WHERE customer_id = $form->{id}|; $dbh->do($query) || $form->dberror($query); - $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; - $dbh->do($query) || $form->dberror($query); +# $query = qq|DELETE FROM shipto +# WHERE trans_id = $form->{id} AND module = 'CT'|; +# $dbh->do($query) || $form->dberror($query); } else { + my $uid = rand() . time; $uid .= $form->{login}; $uid = substr($uid, 2, 75); + if (!$form->{customernumber} && $form->{business}) { + $form->{customernumber} = + $form->update_business($myconfig, $form->{business}); + } + if (!$form->{customernumber}) { + $form->{customernumber} = + $form->update_defaults($myconfig, "customernumber"); + } + + $query = qq|SELECT c.id FROM customer c + WHERE c.customernumber = '$form->{customernumber}'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + (${f_id}) = $sth->fetchrow_array; + $sth->finish; + if (${f_id} ne "") { + $main::lxdebug->leave_sub(); + return 3; + } $query = qq|INSERT INTO customer (name) VALUES ('$uid')|; @@ -276,20 +438,11 @@ sub save_customer { ($form->{id}) = $sth->fetchrow_array; $sth->finish; - if (!$form->{customernumber} && $form->{business}) { - $form->{customernumber} = - $form->update_business($myconfig, $form->{business}); - } - if (!$form->{customernumber}) { - $form->{customernumber} = - $form->update_defaults($myconfig, "customernumber"); - } - } - $query = qq|UPDATE customer SET customernumber = '$form->{customernumber}', name = '$form->{name}', + greeting = '$form->{greeting}', department_1 = '$form->{department_1}', department_2 = '$form->{department_2}', street = '$form->{street}', @@ -319,6 +472,9 @@ sub save_customer { ustid = '$form->{ustid}', username = '$form->{username}', salesman_id = '$form->{salesman_id}', + language_id = '$form->{language_id}', + payment_id = '$form->{payment_id}', + taxzone_id = '$form->{taxzone_id}', user_password = | . $dbh->quote($form->{user_password}) . qq|, c_vendor_id = '$form->{c_vendor_id}', klass = '$form->{klass}' @@ -333,12 +489,22 @@ sub save_customer { cp_name = '$form->{cp_name}', cp_email = '$form->{cp_email}', cp_phone1 = '$form->{cp_phone1}', - cp_phone2 = '$form->{cp_phone2}' - WHERE cp_id = $form->{cp_id}|; + cp_phone2 = '$form->{cp_phone2}', + cp_abteilung = | . $dbh->quote($form->{cp_abteilung}) . qq|, + cp_fax = | . $dbh->quote($form->{cp_fax}) . qq|, + cp_mobile1 = | . $dbh->quote($form->{cp_mobile1}) . qq|, + cp_mobile2 = | . $dbh->quote($form->{cp_mobile2}) . qq|, + cp_satphone = | . $dbh->quote($form->{cp_satphone}) . qq|, + cp_satfax = | . $dbh->quote($form->{cp_satfax}) . qq|, + cp_project = | . $dbh->quote($form->{cp_project}) . qq|, + cp_privatphone = | . $dbh->quote($form->{cp_privatphone}) . qq|, + cp_privatemail = | . $dbh->quote($form->{cp_privatemail}) . qq|, + cp_birthday = | . $dbh->quote($form->{cp_birthday}) . qq| + WHERE cp_id = $form->{cp_id}|; } elsif ($form->{cp_name} || $form->{cp_givenname}) { $query = - qq|INSERT INTO contacts ( cp_cv_id, cp_greeting, cp_title, cp_givenname, cp_name, cp_email, cp_phone1, cp_phone2) - VALUES ($form->{id}, '$form->{cp_greeting}','$form->{cp_title}','$form->{cp_givenname}','$form->{cp_name}','$form->{cp_email}','$form->{cp_phone1}','$form->{cp_phone2}')|; + qq|INSERT INTO contacts ( cp_cv_id, cp_greeting, cp_title, cp_givenname, cp_name, cp_email, cp_phone1, cp_phone2, cp_abteilung, cp_fax, cp_mobile1, cp_mobile2, cp_satphone, cp_satfax, cp_project, cp_privatphone, cp_privatemail, cp_birthday) + VALUES ($form->{id}, '$form->{cp_greeting}','$form->{cp_title}','$form->{cp_givenname}','$form->{cp_name}','$form->{cp_email}','$form->{cp_phone1}','$form->{cp_phone2}', '$form->{cp_abteilung}', | . $dbh->quote($form->{cp_fax}) . qq|,| . $dbh->quote($form->{cp_mobile1}) . qq|,| . $dbh->quote($form->{cp_mobile2}) . qq|,| . $dbh->quote($form->{cp_satphone}) . qq|,| . $dbh->quote($form->{cp_satfax}) . qq|,| . $dbh->quote($form->{cp_project}) . qq|,| . $dbh->quote($form->{cp_privatphone}) . qq|,| . $dbh->quote($form->{cp_privatemail}) . qq|,| . $dbh->quote($form->{cp_birthday}) . qq|)|; } $dbh->do($query) || $form->dberror($query); @@ -352,9 +518,9 @@ sub save_customer { $dbh->do($query) || $form->dberror($query); } } - + print(STDERR "SHIPTO_ID $form->{shipto_id}\n"); # add shipto - $form->add_shipto($dbh, $form->{id}); + $form->add_shipto($dbh, $form->{id}, "CT"); $rc = $dbh->disconnect; @@ -373,8 +539,9 @@ sub save_vendor { map({ $form->{"cp_${_}"} = $form->{"selected_cp_${_}"} if ($form->{"selected_cp_${_}"}); - } qw(title greeting)); - + } qw(title greeting abteilung)); + $form->{"greeting"} = $form->{"selected_company_greeting"} + if ($form->{"selected_company_greeting"}); # escape ' map { $form->{$_} =~ s/\'/\'\'/g } qw(vendornumber name street zipcode city country homepage contact notes cp_title cp_greeting language); @@ -385,6 +552,9 @@ sub save_vendor { $form->{taxincluded} *= 1; $form->{obsolete} *= 1; $form->{business} *= 1; + $form->{payment_id} *= 1; + $form->{language_id} *= 1; + $form->{taxzone_id} *= 1; $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit}); my $query; @@ -395,7 +565,7 @@ sub save_vendor { $dbh->do($query) || $form->dberror($query); $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; + WHERE trans_id = $form->{id} AND module = 'CT'|; $dbh->do($query) || $form->dberror($query); } else { my $uid = time; @@ -425,6 +595,7 @@ sub save_vendor { $query = qq|UPDATE vendor SET vendornumber = '$form->{vendornumber}', name = '$form->{name}', + greeting = '$form->{greeting}', department_1 = '$form->{department_1}', department_2 = '$form->{department_2}', street = '$form->{street}', @@ -453,6 +624,9 @@ sub save_vendor { bank = '$form->{bank}', obsolete = '$form->{obsolete}', ustid = '$form->{ustid}', + payment_id = '$form->{payment_id}', + taxzone_id = '$form->{taxzone_id}', + language_id = '$form->{language_id}', username = '$form->{username}', user_password = '$form->{user_password}', v_customer_id = '$form->{v_customer_id}' @@ -488,7 +662,7 @@ sub save_vendor { } # add shipto - $form->add_shipto($dbh, $form->{id}); + $form->add_shipto($dbh, $form->{id}, "CT"); $rc = $dbh->disconnect; @@ -638,5 +812,84 @@ sub search { $main::lxdebug->leave_sub(); } +sub get_contact { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + my $dbh = $form->dbconnect($myconfig); + my $query = qq|SELECT c.* + FROM contacts c + WHERE c.cp_id = $form->{cp_id} order by c.cp_id limit 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + + +sub get_shipto { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + my $dbh = $form->dbconnect($myconfig); + my $query = qq|SELECT s.* + FROM shipto s + WHERE s.shipto_id = $form->{shipto_id}|; + #WHERE s.shipto_id = $form->{shipto_id} order by s.shipto_id limit 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_delivery { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + my $dbh = $form->dbconnect($myconfig); + $tabelle = ($form->{db} eq "vendor") ? "ap" : "ar"; + + $where = " WHERE 1=1 "; + if ($form->{shipto_id} && $tabelle eq "ar") { + $where .= "AND $tabelle.shipto_id=$form->{shipto_id} "; + } else { + $where .="AND $tabelle.$form->{db}_id=$form->{id} "; + } + if ($form->{from}) { + $where .= "AND $tabelle.transdate >= '$form->{from}' "; + } + if ($form->{to}) { + $where .= "AND $tabelle.transdate <= '$form->{to}' "; + } + my $query = qq|select shiptoname, $tabelle.transdate, $tabelle.invnumber, $tabelle.ordnumber, invoice.description, qty, invoice.unit FROM $tabelle LEFT JOIN shipto ON |; + $query .= ($tabelle eq "ar") ? qq|($tabelle.shipto_id=shipto.shipto_id) |:qq|($tabelle.id=shipto.trans_id) |; + $query .=qq|LEFT join invoice on ($tabelle.id=invoice.trans_id) LEFT join parts ON (parts.id=invoice.parts_id) $where ORDER BY $tabelle.transdate DESC LIMIT 15|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{DELIVERY} }, $ref; + } + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + 1; diff --git a/SL/Common.pm b/SL/Common.pm new file mode 100644 index 000000000..de1735ffe --- /dev/null +++ b/SL/Common.pm @@ -0,0 +1,179 @@ +#==================================================================== +# LX-Office ERP +# Copyright (C) 2004 +# Based on SQL-Ledger Version 2.1.9 +# Web http://www.lx-office.org +# +#==================================================================== + +package Common; + +sub retrieve_parts { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"partnumber"}) { + $filter .= " AND (partnumber ILIKE ?)"; + push(@filter_values, '%' . $form->{"partnumber"} . '%'); + } + if ($form->{"description"}) { + $filter .= " AND (description ILIKE ?)"; + push(@filter_values, '%' . $form->{"description"} . '%'); + } + substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my $query = "SELECT id, partnumber, description FROM parts $filter ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); + my $parts = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$parts}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $parts; +} + +sub retrieve_projects { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"projectnumber"}) { + $filter .= " AND (projectnumber ILIKE ?)"; + push(@filter_values, '%' . $form->{"projectnumber"} . '%'); + } + if ($form->{"description"}) { + $filter .= " AND (description ILIKE ?)"; + push(@filter_values, '%' . $form->{"description"} . '%'); + } + substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my $query = "SELECT id, projectnumber, description FROM project $filter ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); + my $projects = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$projects}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $projects; +} + +sub retrieve_employees { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"name"}) { + $filter .= " AND (name ILIKE ?)"; + push(@filter_values, '%' . $form->{"name"} . '%'); + } + substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my $query = "SELECT id, name FROM employee $filter ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute(@filter_values) || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); + my $employees = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$employees}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $employees; +} + +sub retrieve_delivery_customer { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"name"}) { + $filter .= " (name ILIKE '%$form->{name}%') AND"; + push(@filter_values, '%' . $form->{"name"} . '%'); + } + #substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my $query = "SELECT id, name, customernumber, (street || ', ' || zipcode || city) as address FROM customer WHERE $filter business_id=(SELECT id from business WHERE description='Endkunde') ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); + my $delivery_customers = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$delivery_customers}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $delivery_customers; +} + +sub retrieve_vendor { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $order_by, $order_dir) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my (@filter_values, $filter); + if ($form->{"name"}) { + $filter .= " (name ILIKE '%$form->{name}%') AND"; + push(@filter_values, '%' . $form->{"name"} . '%'); + } + #substr($filter, 1, 3) = "WHERE" if ($filter); + + $order_by =~ s/[^a-zA-Z_]//g; + $order_dir = $order_dir ? "ASC" : "DESC"; + + my $query = "SELECT id, name, customernumber, (street || ', ' || zipcode || city) as address FROM customer WHERE $filter business_id=(SELECT id from business WHERE description='Händler') ORDER BY $order_by $order_dir"; + my $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query . " (" . join(", ", @filter_values) . ")"); + my $vendors = []; + while (my $ref = $sth->fetchrow_hashref()) { + push(@{$vendors}, $ref); + } + $sth->finish(); + $dbh->disconnect(); + + $main::lxdebug->leave_sub(); + + return $vendors; +} + +1; diff --git a/SL/DATEV.pm b/SL/DATEV.pm index 9c617dbb8..e0a0435eb 100644 --- a/SL/DATEV.pm +++ b/SL/DATEV.pm @@ -329,7 +329,7 @@ sub get_transactions { } } if (abs($absumsatz) > 0.01) { - $form->error("Datev-Export fehlgeschlagen!"); + $form->error("Datev-Export fehlgeschlagen! Bei Transaktion $i->[0]->{trans_id}\n"); } } else { push @{ $form->{DATEV} }, \@{$i}; diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm new file mode 100644 index 000000000..05837b577 --- /dev/null +++ b/SL/DBUtils.pm @@ -0,0 +1,43 @@ +package SL::DBUtils; + +require Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw(conv_i conv_date do_query dump_query); + +sub conv_i { + my ($value, $default) = @_; + return (defined($value) && "$value" ne "") ? $value * 1 : $default; +} + +sub conv_date { + my ($value) = @_; + return (defined($value) && "$value" ne "") ? $value : undef; +} + +sub do_query { + my ($form, $dbh, $query) = splice(@_, 0, 3); + + if (0 == scalar(@_)) { + $dbh->do($query) || $form->dberror($query); + } else { + $dbh->do($query, undef, @_) || + $form->dberror($query . " (" . join(", ", @_) . ")"); + } +} + +sub dump_query { + my ($level, $msg, $query) = splice(@_, 0, 3); + while ($query =~ /\?/) { + my $value = shift(@_); + $value =~ s/\'/\\\'/g; + $value = "'${value}'"; + $query =~ s/\?/$value/; + } + + $msg .= " " if ($msg); + + $main::lxdebug->message($level, $msg . $query); +} + +1; diff --git a/SL/DN.pm b/SL/DN.pm new file mode 100644 index 000000000..db8f11df2 --- /dev/null +++ b/SL/DN.pm @@ -0,0 +1,497 @@ +#====================================================================== +# LX-Office ERP +# Copyright (C) 2006 +# Based on SQL-Ledger Version 2.1.9 +# Web http://www.lx-office.org +# +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 1998-2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Dunning process module +# +#====================================================================== + +package DN; + +use SL::Template; +use SL::IS; +use Data::Dumper; + +sub get_config { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT dn.* + FROM dunning_config dn + ORDER BY dn.dunning_level|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{fee} = $form->format_amount($myconfig, $ref->{fee}, 2); + $ref->{interest} = $form->format_amount($myconfig, ($ref->{interest} * 100)); + push @{ $form->{DUNNING} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + + +sub save_config { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + for my $i (1 .. $form->{rowcount}) { + $form->{"active_$i"} *= 1; + $form->{"auto_$i"} *= 1; + $form->{"email_$i"} *= 1; + $form->{"terms_$i"} *= 1; + $form->{"payment_terms_$i"} *= 1; + $form->{"email_attachment_$i"} *= 1; + $form->{"fee_$i"} = $form->parse_amount($myconfig, $form->{"fee_$i"}) * 1; + $form->{"interest_$i"} = $form->parse_amount($myconfig, $form->{"interest_$i"})/100; + + if (($form->{"dunning_level_$i"} ne "") && ($form->{"dunning_description_$i"} ne "")) { + if ($form->{"id_$i"}) { + my $query = qq|UPDATE dunning_config SET + dunning_level = | . $dbh->quote($form->{"dunning_level_$i"}) . qq|, + dunning_description = | . $dbh->quote($form->{"dunning_description_$i"}) . qq|, + email_subject = | . $dbh->quote($form->{"email_subject_$i"}) . qq|, + email_body = | . $dbh->quote($form->{"email_body_$i"}) . qq|, + template = | . $dbh->quote($form->{"template_$i"}) . qq|, + fee = '$form->{"fee_$i"}', + interest = '$form->{"interest_$i"}', + active = '$form->{"active_$i"}', + auto = '$form->{"auto_$i"}', + email = '$form->{"email_$i"}', + email_attachment = '$form->{"email_attachment_$i"}', + payment_terms = $form->{"payment_terms_$i"}, + terms = $form->{"terms_$i"} + WHERE id=$form->{"id_$i"}|; + $dbh->do($query) || $form->dberror($query); + } else { + my $query = qq|INSERT INTO dunning_config (dunning_level, dunning_description, email_subject, email_body, template, fee, interest, active, auto, email, email_attachment, terms, payment_terms) VALUES (| . $dbh->quote($form->{"dunning_level_$i"}) . qq|,| . $dbh->quote($form->{"dunning_description_$i"}) . qq|,| . $dbh->quote($form->{"email_subject_$i"}) . qq|,| . $dbh->quote($form->{"email_body_$i"}) . qq|,| . $dbh->quote($form->{"template_$i"}) . qq|,'$form->{"fee_$i"}','$form->{"interest_$i"}','$form->{"active_$i"}','$form->{"auto_$i"}','$form->{"email_$i"}','$form->{"email_attachment_$i"}',$form->{"terms_$i"},$form->{"payment_terms_$i"})|; + $dbh->do($query) || $form->dberror($query); + } + } + if (($form->{"dunning_description_$i"} eq "") && ($form->{"id_$i"})) { + my $query = qq|DELETE FROM dunning_config WHERE id=$form->{"id_$i"}|; + $dbh->do($query) || $form->dberror($query); + } + } + + $dbh->commit; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub save_dunning { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $rows, $userspath,$spool, $sendmail) = @_; + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + foreach my $row (@{ $rows }) { + + $form->{"interest_$row"} = $form->parse_amount($myconfig,$form->{"interest_$row"}); + $form->{"fee_$row"} = $form->parse_amount($myconfig,$form->{"fee_$row"}); + $form->{send_email} = $form->{"email_$row"}; + + my $query = qq| UPDATE ar set dunning_id = '$form->{"next_dunning_id_$row"}' WHERE id='$form->{"inv_id_$row"}'|; + $dbh->do($query) || $form->dberror($query); + my $query = qq| INSERT into dunning (dunning_id,dunning_level,trans_id,fee,interest,transdate,duedate) VALUES ($form->{"next_dunning_id_$row"},(select dunning_level from dunning_config WHERE id=$form->{"next_dunning_id_$row"}),$form->{"inv_id_$row"},'$form->{"fee_$row"}', '$form->{"interest_$row"}',current_date, |.$dbh->quote($form->{"next_duedate_$row"}) . qq|)|; + $dbh->do($query) || $form->dberror($query); + } + + my $query = qq| SELECT invnumber, ordnumber, customer_id, amount, netamount, ar.transdate, ar.duedate, paid, amount-paid AS open_amount, template AS formname, email_subject, email_body, email_attachment, da.fee, da.interest, da.transdate AS dunning_date, da.duedate AS dunning_duedate FROM ar LEFT JOIN dunning_config ON (dunning_config.id=ar.dunning_id) LEFT JOIN dunning da ON (ar.id=da.trans_id) where ar.id IN $form->{inv_ids}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my $first = 1; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($first) { + map({ $form->{"dn_$_"} = []; } keys(%{$ref})); + $first = 0; + } + map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2) } qw(amount netamount paid open_amount fee interest); + map { $form->{$_} = $ref->{$_} } keys %$ref; + #print(STDERR Dumper($ref)); + map { push @{ $form->{"dn_$_"} }, $ref->{$_}} keys %$ref; + } + $sth->finish; + + IS->customer_details($myconfig,$form); + #print(STDERR Dumper($form->{dn_invnumber})); + $form->{templates} = "$myconfig->{templates}"; + + + + $form->{language} = $form->get_template_language(\%myconfig); + $form->{printer_code} = $form->get_printer_code(\%myconfig); + + if ($form->{language} ne "") { + $form->{language} = "_" . $form->{language}; + } + + if ($form->{printer_code} ne "") { + $form->{printer_code} = "_" . $form->{printer_code}; + } + + $form->{IN} = "$form->{formname}$form->{language}$form->{printer_code}.html"; + if ($form->{format} eq 'postscript') { + $form->{postscript} = 1; + $form->{IN} =~ s/html$/tex/; + } elsif ($form->{"format"} =~ /pdf/) { + $form->{pdf} = 1; + if ($form->{"format"} =~ /opendocument/) { + $form->{IN} =~ s/html$/odt/; + } else { + $form->{IN} =~ s/html$/tex/; + } + } elsif ($form->{"format"} =~ /opendocument/) { + $form->{"opendocument"} = 1; + $form->{"IN"} =~ s/html$/odt/; + } + + if ($form->{"send_email"} && ($form->{email} ne "")) { + $form->{media} = 'email'; + } + + $form->{keep_tmpfile} = 0; + if ($form->{media} eq 'email') { + $form->{subject} = qq|$form->{label} $form->{"${inv}number"}| + unless $form->{subject}; + if (!$form->{email_attachment}) { + $form->{do_not_attach} = 1; + } else { + $form->{do_not_attach} = 0; + } + $form->{subject} = parse_strings($myconfig, $form, $userspath, $form->{email_subject}); + $form->{message} = parse_strings($myconfig, $form, $userspath, $form->{email_body}); + + $form->{OUT} = "$sendmail"; + + } else { + + my $uid = rand() . time; + + $uid .= $form->{login}; + + $uid = substr($uid, 2, 75); + $filename = $uid; + + $filename .= '.pdf'; + $form->{OUT} = ">$spool/$filename"; + push(@{ $form->{DUNNING_PDFS} }, $filename); + $form->{keep_tmpfile} = 1; + } + + $form->parse_template($myconfig, $userspath); + + $dbh->commit; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); +} + +sub get_invoices { + + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $where = qq| WHERE 1=1 AND a.paid < a.amount AND a.duedate < current_date AND dnn.id = (select id from dunning_config WHERE dunning_level>(select case when a.dunning_id is null then 0 else (select dunning_level from dunning_config where id=a.dunning_id order by dunning_level limit 1 ) end from dunning_config limit 1) limit 1) |; + + if ($form->{"$form->{vc}_id"}) { + $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } else { + if ($form->{ $form->{vc} }) { + $where .= " AND lower(ct.name) LIKE '$name'"; + } + } + + my $sortorder = join ', ', + ("a.id", $form->sort_columns(transdate, duedate, name)); + $sortorder = $form->{sort} if $form->{sort}; + + $where .= " AND lower(ordnumber) LIKE '$form->{ordnumber}'" if $form->{ordnumber}; + $where .= " AND lower(invnumber) LIKE '$form->{invnumber}'" if $form->{invnumber}; + + + $form->{minamount} = $form->parse_amount($myconfig,$form->{minamount}); + $where .= " AND a.dunning_id='$form->{dunning_level}'" + if $form->{dunning_level}; + $where .= " AND a.ordnumber ilike '%$form->{ordnumber}%'" + if $form->{ordnumber}; + $where .= " AND a.invnumber ilike '%$form->{invnumber}%'" + if $form->{invnumber}; + $where .= " AND a.notes ilike '%$form->{notes}%'" + if $form->{notes}; + $where .= " AND ct.name ilike '%$form->{customer}%'" + if $form->{customer}; + + $where .= " AND a.amount-a.paid>'$form->{minamount}'" + if $form->{minamount}; + + $where .= " ORDER by $sortorder"; + + $paymentdate = ($form->{paymentuntil}) ? "'$form->{paymentuntil}'" : current_date; + + $query = qq|SELECT a.id, a.ordnumber, a.transdate, a.invnumber,a.amount, ct.name AS customername, a.customer_id, a.duedate,da.fee AS old_fee, dnn.fee as fee, dn.dunning_description, da.transdate AS dunning_date, da.duedate AS dunning_duedate, a.duedate + dnn.terms - current_date AS nextlevel, $paymentdate - a.duedate AS pastdue, dn.dunning_level, current_date + dnn.payment_terms AS next_duedate, dnn.dunning_description AS next_dunning_description, dnn.id AS next_dunning_id, dnn.interest AS interest_rate, dnn.terms + FROM dunning_config dnn, ar a + JOIN customer ct ON (a.customer_id = ct.id) + LEFT JOIN dunning_config dn ON (dn.id = a.dunning_id) + LEFT JOIN dunning da ON (da.trans_id=a.id) + $where|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{fee} += $ref->{old_fee}; + $ref->{interest} = ($ref->{amount} * $ref->{pastdue} * $ref->{interest_rate}) /360; + $ref->{interest} = $form->round_amount($ref->{interest},2); + map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2)} qw(amount fee interest); + if ($ref->{pastdue} >= $ref->{terms}) { + push @{ $form->{DUNNINGS} }, $ref; + } + } + + $sth->finish; + + $query = qq|select id, dunning_description FROM dunning_config order by dunning_level|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{DUNNING_CONFIG} }, $ref; + } + + $sth->finish; + + $dbh->disconnect; + $main::lxdebug->leave_sub(); +} + +sub get_dunning { + + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $where = qq| WHERE 1=1 AND da.trans_id=a.id|; + + if ($form->{"$form->{vc}_id"}) { + $where .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } else { + if ($form->{ $form->{vc} }) { + $where .= " AND lower(ct.name) LIKE '$name'"; + } + } + + my $sortorder = join ', ', + ("a.id", $form->sort_columns(transdate, duedate, name)); + $sortorder = $form->{sort} if $form->{sort}; + + $where .= " AND lower(ordnumber) LIKE '$form->{ordnumber}'" if $form->{ordnumber}; + $where .= " AND lower(invnumber) LIKE '$form->{invnumber}'" if $form->{invnumber}; + + + $form->{minamount} = $form->parse_amount($myconfig,$form->{minamount}); + $where .= " AND a.dunning_id='$form->{dunning_level}'" + if $form->{dunning_level}; + $where .= " AND a.ordnumber ilike '%$form->{ordnumber}%'" + if $form->{ordnumber}; + $where .= " AND a.invnumber ilike '%$form->{invnumber}%'" + if $form->{invnumber}; + $where .= " AND a.notes ilike '%$form->{notes}%'" + if $form->{notes}; + $where .= " AND ct.name ilike '%$form->{customer}%'" + if $form->{customer}; + $where .= " AND a.amount > a.paid AND da.dunning_id=a.dunning_id " unless ($form->{showold}); + + $where .= " AND a.transdate >='$form->{transdatefrom}' " if ($form->{transdatefrom}); + $where .= " AND a.transdate <='$form->{transdateto}' " if ($form->{transdateto}); + $where .= " AND da.transdate >='$form->{dunningfrom}' " if ($form->{dunningfrom}); + $where .= " AND da.transdate <='$form->{dunningto}' " if ($form->{dunningto}); + + $where .= " ORDER by $sortorder"; + + + $query = qq|SELECT a.id, a.ordnumber, a.transdate, a.invnumber,a.amount, ct.name AS customername, a.duedate,da.fee ,da.interest, dn.dunning_description, da.transdate AS dunning_date, da.duedate AS dunning_duedate + FROM ar a + JOIN customer ct ON (a.customer_id = ct.id), + dunning da LEFT JOIN dunning_config dn ON (da.dunning_id=dn.id) + $where|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + map { $ref->{$_} = $form->format_amount($myconfig, $ref->{$_}, 2)} qw(amount fee interest); + push @{ $form->{DUNNINGS} }, $ref; + } + + $sth->finish; + + + + $dbh->disconnect; + $main::lxdebug->leave_sub(); +} + + +sub parse_strings { + + $main::lxdebug->enter_sub(); + + my ($myconfig, $form, $userspath, $string) = @_; + + my $format = $form->{format}; + $form->{format} = "html"; + + $tmpstring = "parse_string.html"; + $tmpfile = "$myconfig->{templates}/$tmpstring"; + open(OUT, ">$tmpfile") or $form->error("$tmpfile : $!"); + print(OUT $string); + close(OUT); + + my $in = $form->{IN}; + $form->{IN} = $tmpstring; + $template = HTMLTemplate->new($tmpstring, $form, $myconfig, $userspath); + + my $fileid = time; + $form->{tmpfile} = "$userspath/${fileid}.$tmpstring"; + $out = $form->{OUT}; + $form->{OUT} = ">$form->{tmpfile}"; + + if ($form->{OUT}) { + open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!"); + } + if (!$template->parse(*OUT)) { + $form->cleanup(); + $form->error("$form->{IN} : " . $template->get_error()); + } + + close(OUT); + my $result = ""; + open(IN, $form->{tmpfile}) or $form->error($form->cleanup . "$form->{tmpfile} : $!"); + + while () { + $result .= $_; + } + + close(IN); +# unlink($tmpfile); +# unlink($form->{tmpfile}); + $form->{IN} = $in; + $form->{format} = $format; + + $main::lxdebug->leave_sub(); + return $result; +} + +sub melt_pdfs { + + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $userspath) = @_; + + foreach my $file (@{ $form->{DUNNING_PDFS} }) { + $inputfiles .= " $userspath/$file "; + } + + my $outputfile = "$userspath/dunning.pdf"; + system("gs -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -sOutputFile=$outputfile $inputfiles"); + foreach my $file (@{ $form->{DUNNING_PDFS} }) { + unlink("$userspath/$file"); + } + $out=""; + + + $form->{OUT} = $out; + + my $numbytes = (-s $outputfile); + open(IN, $outputfile) + or $form->error($self->cleanup . "$outputfile : $!"); + + $form->{copies} = 1 unless $form->{media} eq 'printer'; + + chdir("$self->{cwd}"); + + for my $i (1 .. $form->{copies}) { + if ($form->{OUT}) { + open(OUT, $form->{OUT}) + or $form->error($form->cleanup . "$form->{OUT} : $!"); + } else { + + # launch application + print qq|Content-Type: Application/PDF +Content-Disposition: attachment; filename="$outputfile" +Content-Length: $numbytes + +|; + + open(OUT, ">-") or $form->error($form->cleanup . "$!: STDOUT"); + + } + + while () { + print OUT $_; + } + + close(OUT); + + seek IN, 0, 0; + } + + close(IN); + unlink("$userspath/$outputfile"); + + $main::lxdebug->leave_sub(); +} + +1; diff --git a/SL/Form.pm b/SL/Form.pm index 6d5c30a5b..ec41cc074 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -36,9 +36,17 @@ #====================================================================== package Form; +use Data::Dumper; + +use Cwd; +use HTML::Template; +use SL::Template; +use CGI::Ajax; +use SL::Menu; +use CGI; sub _input_to_hash { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my $input = $_[0]; my %in = (); @@ -49,13 +57,13 @@ sub _input_to_hash { $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); @@ -106,11 +114,11 @@ sub _request_to_hash { } } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return %ATTACH; } else { - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return _input_to_hash($input); } } @@ -135,13 +143,10 @@ 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.2.2"; - $self->{dbversion} = "2.2.0"; + $self->{version} = "2.4.0"; $main::lxdebug->leave_sub(); @@ -161,7 +166,7 @@ sub debug { } sub escape { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $str, $beenthere) = @_; @@ -172,13 +177,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) = @_; @@ -187,7 +192,7 @@ 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; } @@ -196,7 +201,7 @@ sub quote { my ($self, $str) = @_; if ($str && !ref($str)) { - $str =~ s/"/"/g; + $str =~ s/\"/"/g; } $str; @@ -207,13 +212,32 @@ sub unquote { my ($self, $str) = @_; if ($str && !ref($str)) { - $str =~ s/"/"/g; + $str =~ s/"/\"/g; } $str; } +sub quote_html { + $main::lxdebug->enter_sub(2); + + my ($self, $str) = @_; + + my %replace = + ('order' => ['"', '<', '>'], + '<' => '<', + '>' => '>', + '"' => '"', + ); + + map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + $main::lxdebug->leave_sub(2); + + return $str; +} + sub hide_form { my $self = shift; @@ -238,24 +262,9 @@ sub error { $main::lxdebug->enter_sub(); my ($self, $msg) = @_; - if ($ENV{HTTP_USER_AGENT}) { $msg =~ s/\n/
/g; - - $self->header; - - print qq| - - -

Error!

- -

$msg - - - - |; - - die "Error: $msg\n"; + $self->show_generic_error($msg); } else { @@ -382,7 +391,7 @@ function fokus(){document.$self->{fokus}.focus();} } #Set Calendar - $jsscript = ""; + my $jsscript = ""; if ($self->{jsscript} == 1) { $jsscript = qq| @@ -398,9 +407,13 @@ function fokus(){document.$self->{fokus}.focus();} ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; - + $ajax = ""; + foreach $item (@ { $self->{AJAX} }) { + $ajax .= $item->show_javascript(); + } print qq|Content-Type: text/html + $self->{titlebar} $stylesheet @@ -408,7 +421,22 @@ function fokus(){document.$self->{fokus}.focus();} $favicon $charset $jsscript + $ajax $fokus + + + + + + |; @@ -418,6 +446,122 @@ function fokus(){document.$self->{fokus}.focus();} $main::lxdebug->leave_sub(); } +sub parse_html_template { + $main::lxdebug->enter_sub(); + + 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); + } + + 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 { @@ -466,7 +610,7 @@ sub write_trigger { ); |; } - $jsscript = qq| + my $jsscript = qq| @@ -506,115 +650,55 @@ sub sort_columns { return @columns; } - +# sub format_amount { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount, $places, $dash) = @_; - - #Workaround for $format_amount calls without $places - if (!defined $places) { - (my $dec) = ($amount =~ /\.(\d+)/); - $places = length $dec; - } - - 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); - my $fillup = ""; + $amount = $self->round_amount($amount, $places) if ($places =~ /\d/); - if ($amount != 0) { - if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) - { - my ($whole, $dec) = split /\./, "$amount"; - $whole =~ s/-//; - $amount = join '', reverse split //, $whole; - $fillup = "0" x ($places - length($dec)); + 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 '1,000.00') { - $amount =~ s/\d{3,}?/$&,/g; - $amount =~ s/,$//; - $amount = join '', reverse split //, $amount; - $amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0); - } + $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters - if ($myconfig->{numberformat} eq '1.000,00') { - $amount =~ s/\d{3,}?/$&./g; - $amount =~ s/\.$//; - $amount = join '', reverse split //, $amount; - $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); - } + $amount = $p[0]; + $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); - if ($myconfig->{numberformat} eq '1000,00') { - $amount = "$whole"; - $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); - } - - 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"; - } - } - - $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) = @_; - $main::lxdebug->message(LXDebug::DEBUG2, "Start amount: $amount"); if ($myconfig->{in_numberformat} == 1) { - # Extra input number format 1000.00 or 1000,00 - $main::lxdebug->message(LXDebug::DEBUG2, - "in_numberformat: " . $main::locale->text('1000,00 or 1000.00')); $amount =~ s/,/\./g; - - #$main::lxdebug->message(LXDebug::DEBUG2, "1.Parsed Number: $amount") if ($amount); $amount = scalar reverse $amount; - - #$main::lxdebug->message(LXDebug::DEBUG2, "2.Parsed Number: $amount") if ($amount); $amount =~ s/\./DOT/; - - #$main::lxdebug->message(LXDebug::DEBUG2, "3.Parsed Number: $amount") if ($amount); $amount =~ s/\.//g; - - #$main::lxdebug->message(LXDebug::DEBUG2, "4.Parsed Number: $amount") if ($amount); $amount =~ s/DOT/\./; - - #$main::lxdebug->message(LXDebug::DEBUG2, "5.Parsed Number:" . $amount) if ($amount); $amount = scalar reverse $amount; - $main::lxdebug->message(LXDebug::DEBUG2, - "Parsed amount:" . $amount . "\n"); - + $main::lxdebug->leave_sub(2); return ($amount * 1); - } - $main::lxdebug->message(LXDebug::DEBUG2, - "in_numberformat: " . $main::locale->text('equal Outputformat')); - $main::lxdebug->message(LXDebug::DEBUG2, - " = numberformat: $myconfig->{numberformat}"); + if ( ($myconfig->{numberformat} eq '1.000,00') || ($myconfig->{numberformat} eq '1000,00')) { $amount =~ s/\.//g; @@ -622,20 +706,18 @@ sub parse_amount { } if ($myconfig->{numberformat} eq "1'000.00") { - $amount =~ s/'//g; + $amount =~ s/\'//g; } $amount =~ s/,//g; - $main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount . "\n") - if ($amount); - $main::lxdebug->leave_sub(); + $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 $round_amount; @@ -649,7 +731,7 @@ sub round_amount { $amount = $amount * (10**($places)); $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places)); - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $round_amount; @@ -659,39 +741,47 @@ sub parse_template { $main::lxdebug->enter_sub(); my ($self, $myconfig, $userspath) = @_; - - # { 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, $current_row) = (1, 1, 0); - 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}))); + 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'}"); + } # 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)); - - open(IN, "$self->{templates}/$self->{IN}") - or $self->error("$self->{IN} : $!"); - - @_ = ; - close(IN); + qw(email tel fax name signature company address businessnumber)); $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}"; } @@ -703,237 +793,17 @@ 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 -- or the user has forced one - if ( - (($current_line + $lines) > $lpp) - || ($self->{"_forced_pagebreaks"} - && grep(/^${current_row}$/, @{ $self->{"_forced_pagebreaks"} })) - ) { - 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; - $current_row++; - } - $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; - s/<\/nobr>/ /g; - print OUT; + if (!$template->parse(*OUT)) { + $self->cleanup(); + $self->error("$self->{IN} : " . $template->get_error()); } close(OUT); + + use Data::Dumper; + #print(STDERR Dumper($self)); - # { 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') { @@ -946,6 +816,7 @@ sub parse_template { $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')) { @@ -953,7 +824,7 @@ sub parse_template { $mail->{message} =~ s/\r\n/
\n/g; $myconfig->{signature} =~ s/\\n/
\n/g; - $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; + $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; open(IN, $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); @@ -965,10 +836,11 @@ sub parse_template { } else { - @{ $mail->{attachments} } = ($self->{tmpfile}); + @{ $mail->{attachments} } = ($self->{tmpfile}) unless ($form->{do_not_attach}); - $myconfig->{signature} =~ s/\\n/\r\n/g; - $mail->{message} .= "\r\n--\r\n$myconfig->{signature}"; + $mail->{message} =~ s/\r\n/\n/g; + $myconfig->{signature} =~ s/\\n/\n/g; + $mail->{message} .= "\n-- \n$myconfig->{signature}"; } @@ -986,7 +858,8 @@ 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}) @@ -994,7 +867,7 @@ sub parse_template { } else { # launch application - print qq|Content-Type: application/$self->{format} + print qq|Content-Type: | . $template->get_mime_type() . qq| Content-Disposition: attachment; filename="$self->{tmpfile}" Content-Length: $numbytes @@ -1016,10 +889,10 @@ Content-Length: $numbytes close(IN); } - $self->cleanup; - } + $self->cleanup; + chdir("$self->{cwd}"); $main::lxdebug->leave_sub(); } @@ -1039,7 +912,7 @@ sub cleanup { } if ($self->{tmpfile}) { - + $self->{tmpfile} =~ s|.*/||g; # strip extension $self->{tmpfile} =~ s/\.\w+$//g; my $tmpfile = $self->{tmpfile}; @@ -1053,100 +926,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); - - foreach my $field (@fields) { - next unless ($self->{$field} =~ /\/); - $self->{$field} =~ s/\//g; - if ($field =~ /.*_(\d+)$/) { - if (!$self->{"_forced_pagebreaks"}) { - $self->{"_forced_pagebreaks"} = []; - } - push(@{ $self->{"_forced_pagebreaks"} }, "$1"); - } - } - - 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; - } - - # Allow some HTML markup to be converted into the output format's - # corresponding markup code, e.g. bold or italic. - if ('html' eq $format) { - my @markup_replace = ('b', 'i', 's', 'u'); - - foreach my $key (@markup_replace) { - map({ $self->{$_} =~ s/\<(\/?)${key}\>/<$1${key}>/g } @fields); - } - - } elsif ('tex' eq $format) { - my %markup_replace = ('b' => 'textbf', - 'i' => 'textit', - 'u' => 'underline'); - - foreach my $field (@fields) { - foreach my $key (keys(%markup_replace)) { - my $new = $markup_replace{$key}; - $self->{$field} =~ - s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi; - } - } - } - - $main::lxdebug->leave_sub(); -} - sub datetonum { $main::lxdebug->enter_sub(); @@ -1328,11 +1107,53 @@ sub get_exchangerate { my ($exchangerate) = $sth->fetchrow_array; $sth->finish; + if ($exchangerate == 0) { + $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, p.description_long FROM payment_terms p + WHERE p.id = $self->{payment_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto}, $self->{payment_terms}) = $sth->fetchrow_array; + + $sth->finish; + my $query = qq|SELECT date '$transdate' + $self->{terms_netto} AS netto_date,date '$transdate' + $self->{terms_skonto} AS skonto_date FROM payment_terms + LIMIT 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + ($self->{netto_date}, $self->{skonto_date}) = $sth->fetchrow_array; + $sth->finish; + + $self->{skonto_amount} = $self->format_amount($myconfig, ($self->parse_amount($myconfig, $self->{subtotal}) * $self->{percent_skonto}), 2); + + $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; + + $dbh->disconnect; + } + + $main::lxdebug->leave_sub(); + +} + sub check_exchangerate { $main::lxdebug->enter_sub(); @@ -1360,10 +1181,90 @@ sub check_exchangerate { 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 { $form->{$_} = $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 ( @@ -1374,18 +1275,34 @@ sub add_shipto { } $self->{"shipto$item"} =~ s/\'/\'\'/g; } - if ($shipto) { - my $query = + 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, + 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(); @@ -1435,7 +1352,7 @@ sub get_contacts { my ($self, $dbh, $id) = @_; - my $query = qq|SELECT c.cp_id, c.cp_cv_id, c.cp_name, c.cp_givenname + my $query = qq|SELECT c.cp_id, c.cp_cv_id, c.cp_name, c.cp_givenname, c.cp_abteilung FROM contacts c WHERE cp_cv_id=$id|; my $sth = $dbh->prepare($query); @@ -1448,7 +1365,7 @@ sub get_contacts { } if ($i == 0) { - push @{ $self->{all_contacts} }, { { "", "", "", "", "" } }; + push @{ $self->{all_contacts} }, { { "", "", "", "", "", "" } }; } $sth->finish; $main::lxdebug->leave_sub(); @@ -1585,6 +1502,105 @@ sub all_vc { } $sth->finish; + # get languages + $query = qq|SELECT id, description + FROM language + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->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 || $form->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 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->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 || $form->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 || $form->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 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->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 || $form->dberror($query); + + $self->{BUCHUNGSGRUPPEN} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{BUCHUNGSGRUPPEN} }, $ref; + } + $sth->finish; + $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -1632,35 +1648,69 @@ sub create_links { my ($query, $sth); my $dbh = $self->dbconnect($myconfig); - my %xkeyref = (); - # now get the account numbers - $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id - FROM chart c - WHERE c.link LIKE '%$module%' - ORDER BY c.accno|; + if (!$self->{id}) { + + 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/) { + $sth->finish; - # cross reference for keys - $xkeyref{ $ref->{accno} } = $key; - push @{ $self->{"${module}_links"}{$key} }, - { accno => $ref->{accno}, - description => $ref->{description}, - taxkey => $ref->{taxkey_id} }; + # get tax zones + $query = qq|SELECT id, description + FROM tax_zones|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); - $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; - } - } + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{TAXZONE} }, $ref; } $sth->finish; @@ -1670,7 +1720,7 @@ sub create_links { $query = qq| SELECT * FROM tax t|; $sth = $dbh->prepare($query); $sth->execute || $self->dberror($query); - $form->{TAX} = (); + $self->{TAX} = (); while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { push @{ $self->{TAX} }, $ref; } @@ -1685,7 +1735,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) @@ -1700,14 +1750,50 @@ sub create_links { } $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.oid,a.transdate|; $sth = $dbh->prepare($query); @@ -1729,12 +1815,15 @@ sub create_links { 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; + $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, @@ -1768,7 +1857,7 @@ sub create_links { if ($self->{"$self->{vc}_id"}) { # only setup currency - ($self->{currency}) = split /:/, $self->{currencies}; + ($self->{currency}) = split(/:/, $self->{currencies}); } else { @@ -1785,6 +1874,8 @@ sub create_links { } + $sth->finish; + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -2045,7 +2136,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; @@ -2073,7 +2164,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; @@ -2292,10 +2383,14 @@ sub new { my ($type, $country, $NLS_file) = @_; my $self = {}; - %self = (); if ($country && -d "locale/$country") { + local *IN; $self->{countrycode} = $country; - eval { require "locale/$country/$NLS_file"; }; + if (open(IN, "locale/$country/$NLS_file")) { + my $code = join("", ); + eval($code); + close(IN); + } } $self->{NLS_file} = $NLS_file; @@ -2315,7 +2410,7 @@ sub new { sub text { my ($self, $text) = @_; - return (exists $self{texts}{$text}) ? $self{texts}{$text} : $text; + return (exists $self->{texts}{$text}) ? $self->{texts}{$text} : $text; } sub findsub { @@ -2323,8 +2418,8 @@ sub findsub { my ($self, $text) = @_; - if (exists $self{subs}{$text}) { - $text = $self{subs}{$text}; + if (exists $self->{subs}{$text}) { + $text = $self->{subs}{$text}; } else { if ($self->{countrycode} && $self->{NLS_file}) { Form->error( diff --git a/SL/GL.pm b/SL/GL.pm index d6723d3c5..660c148ef 100644 --- a/SL/GL.pm +++ b/SL/GL.pm @@ -145,10 +145,25 @@ sub post_transaction { # insert acc_trans transactions for $i (1 .. $form->{rowcount}) { - + my $taxkey; + my $rate; # extract accno + print(STDERR $form->{"taxchart_$i"}, "TAXCHART\n"); my ($accno) = split(/--/, $form->{"accno_$i"}); my ($taxkey, $rate) = split(/--/, $form->{"taxchart_$i"}); + ($form->{"tax_id_$i"}, $NULL) = split /--/, $form->{"taxchart_$i"}; + if ($form->{"tax_id_$i"} ne "") { + $query = qq|SELECT t.taxkey, t.rate + FROM tax t + WHERE t.id=$form->{"tax_id_$i"}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ($taxkey, $rate) = + $sth->fetchrow_array; + $sth->finish; + } + my $amount = 0; my $debit = $form->{"debit_$i"}; my $credit = $form->{"credit_$i"}; @@ -194,7 +209,7 @@ sub post_transaction { VALUES ($form->{id}, (SELECT t.chart_id FROM tax t - WHERE t.taxkey = $taxkey), + WHERE t.id = $form->{"tax_id_$i"}), $amount, '$form->{transdate}', | . $dbh->quote($form->{"source_$i"}) . qq|, | . $dbh->quote($form->{"memo_$i"}) . qq|, @@ -362,7 +377,7 @@ sub all_transactions { } my $query = - qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference, ac.taxkey, t.taxkey AS sorttax, + qq|SELECT ac.oid AS acoid, g.id, 'gl' AS type, $false AS invoice, g.reference, ac.taxkey, c.link, g.description, ac.transdate, ac.source, ac.trans_id, ac.amount, c.accno, c.gifi_accno, g.notes, t.chart_id, ac.oid FROM gl g, acc_trans ac, chart c LEFT JOIN tax t ON @@ -371,7 +386,7 @@ sub all_transactions { AND ac.chart_id = c.id AND g.id = ac.trans_id UNION - SELECT a.id, 'ar' AS type, a.invoice, a.invnumber, ac.taxkey, t.taxkey AS sorttax, + SELECT ac.oid AS acoid, a.id, 'ar' AS type, a.invoice, a.invnumber, ac.taxkey, c.link, ct.name, ac.transdate, ac.source, ac.trans_id, ac.amount, c.accno, c.gifi_accno, a.notes, t.chart_id, ac.oid FROM ar a, acc_trans ac, customer ct, chart c LEFT JOIN tax t ON @@ -381,7 +396,7 @@ sub all_transactions { AND a.customer_id = ct.id AND a.id = ac.trans_id UNION - SELECT a.id, 'ap' AS type, a.invoice, a.invnumber, ac.taxkey, t.taxkey AS sorttax, + SELECT ac.oid AS acoid, a.id, 'ap' AS type, a.invoice, a.invnumber, ac.taxkey, c.link, ct.name, ac.transdate, ac.source, ac.trans_id, ac.amount, c.accno, c.gifi_accno, a.notes, t.chart_id, ac.oid FROM ap a, acc_trans ac, vendor ct, chart c LEFT JOIN tax t ON @@ -390,18 +405,28 @@ sub all_transactions { AND ac.chart_id = c.id AND a.vendor_id = ct.id AND a.id = ac.trans_id - ORDER BY $sortorder transdate, trans_id, taxkey DESC, sorttax DESC,oid|; + ORDER BY $sortorder transdate,acoid, trans_id, taxkey DESC|; + + # Show all $query in Debuglevel LXDebug::QUERY + $callingdetails = (caller (0))[3]; + $main::lxdebug->message(LXDebug::QUERY, "$callingdetails \$query=\n $query"); + my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); my $trans_id = ""; my $trans_id2 = ""; + while (my $ref0 = $sth->fetchrow_hashref(NAME_lc)) { + $trans_id = $ref0->{id}; - if ($trans_id != $trans_id2) { + + if ($trans_id != $trans_id2) { # first line of a booking + if ($trans_id2) { push @{ $form->{GL} }, $ref; $balance = 0; } + $ref = $ref0; $trans_id2 = $ref->{id}; @@ -427,64 +452,101 @@ sub all_transactions { $ref->{module} = "ar"; } } + $balance = $ref->{amount}; - $i = 0; - $j = 0; - $k = 0; - $l = 0; - if ($ref->{amount} < 0) { - if ($ref->{chart_id} > 0) { - $ref->{debit_tax}{$i} = $ref->{amount} * -1; - $ref->{debit_tax_accno}{$i} = $ref->{accno}; + + # Linenumbers of General Ledger + $k = 0; # Debit # AP # Soll + $l = 0; # Credit # AR # Haben + $i = 0; # Debit Tax # AP_tax # VSt + $j = 0; # Credit Tax # AR_tax # USt + + + if ($ref->{chart_id} > 0) { # all tax accounts first line, no line increasing + if ($ref->{amount} < 0) { + if ($ref->{link} =~ /AR_tax/) { + $ref->{credit_tax}{$j} = $ref->{amount}; + $ref->{credit_tax_accno}{$j} = $ref->{accno}; + } + if ($ref->{link} =~ /AP_tax/) { + $ref->{debit_tax}{$i} = $ref->{amount} * -1; + $ref->{debit_tax_accno}{$i} = $ref->{accno}; + } } else { + if ($ref->{link} =~ /AR_tax/) { + $ref->{credit_tax}{$j} = $ref->{amount}; + $ref->{credit_tax_accno}{$j} = $ref->{accno}; + } + if ($ref->{link} =~ /AP_tax/) { + $ref->{debit_tax}{$i} = $ref->{amount} * -1; + $ref->{debit_tax_accno}{$i} = $ref->{accno}; + } + } + } else { #all other accounts first line + if ($ref->{amount} < 0) { $ref->{debit}{$k} = $ref->{amount} * -1; $ref->{debit_accno}{$k} = $ref->{accno}; $ref->{debit_taxkey}{$k} = $ref->{taxkey}; - } - } else { - if ($ref->{chart_id} > 0) { - $ref->{credit_tax}{$j} = $ref->{amount}; - $ref->{credit_tax_accno}{$j} = $ref->{accno}; + } else { - $ref->{credit}{$l} = $ref->{amount}; + $ref->{credit}{$l} = $ref->{amount} * 1; $ref->{credit_accno}{$l} = $ref->{accno}; $ref->{credit_taxkey}{$l} = $ref->{taxkey}; + + } } - } else { + + } else { # following lines of a booking, line increasing + $ref2 = $ref0; + $trans_old =$trans_id2; $trans_id2 = $ref2->{id}; - - # if ($form->{accno} eq ''){ # flo & udo: if general report, - # then check balance - # while (abs($balance) >= 0.015) { - # my $ref2 = $sth->fetchrow_hashref(NAME_lc) - # || $form->error("Unbalanced ledger!"); - # + $balance = (int($balance * 100000) + int(100000 * $ref2->{amount})) / 100000; - if ($ref2->{amount} < 0) { - if ($ref2->{chart_id} > 0) { - if ($ref->{debit_tax_accno}{$i} ne "") { - $i++; + + + if ($ref2->{chart_id} > 0) { # all tax accounts, following lines + if ($ref2->{amount} < 0) { + if ($ref2->{link} =~ /AR_tax/) { + if ($ref->{credit_tax_accno}{$j} ne "") { + $j++; + } + $ref->{credit_tax}{$j} = $ref2->{amount}; + $ref->{credit_tax_accno}{$j} = $ref2->{accno}; + } + if ($ref2->{link} =~ /AP_tax/) { + if ($ref->{debit_tax_accno}{$i} ne "") { + $i++; + } + $ref->{debit_tax}{$i} = $ref2->{amount} * -1; + $ref->{debit_tax_accno}{$i} = $ref2->{accno}; } - $ref->{debit_tax}{$i} = $ref2->{amount} * -1; - $ref->{debit_tax_accno}{$i} = $ref2->{accno}; } else { + if ($ref2->{link} =~ /AR_tax/) { + if ($ref->{credit_tax_accno}{$j} ne "") { + $j++; + } + $ref->{credit_tax}{$j} = $ref2->{amount}; + $ref->{credit_tax_accno}{$j} = $ref2->{accno}; + } + if ($ref2->{link} =~ /AP_tax/) { + if ($ref->{debit_tax_accno}{$i} ne "") { + $i++; + } + $ref->{debit_tax}{$i} = $ref2->{amount} * -1; + $ref->{debit_tax_accno}{$i} = $ref2->{accno}; + } + } + } else { # all other accounts, following lines + if ($ref2->{amount} < 0) { if ($ref->{debit_accno}{$k} ne "") { $k++; } - $ref->{debit}{$k} = $ref2->{amount} * -1; + $ref->{debit}{$k} = $ref2->{amount} * - 1; $ref->{debit_accno}{$k} = $ref2->{accno}; $ref->{debit_taxkey}{$k} = $ref2->{taxkey}; - } - } else { - if ($ref2->{chart_id} > 0) { - if ($ref->{credit_tax_accno}{$j} ne "") { - $j++; - } - $ref->{credit_tax}{$j} = $ref2->{amount}; - $ref->{credit_tax_accno}{$j} = $ref2->{accno}; } else { if ($ref->{credit_accno}{$l} ne "") { $l++; @@ -494,15 +556,7 @@ sub all_transactions { $ref->{credit_taxkey}{$l} = $ref2->{taxkey}; } } - - # } - # } else { - # # if account-report, then calculate the Balance?! - # # ToDo: Calculate the Balance - # 1; - # } } - } push @{ $form->{GL} }, $ref; $sth->finish; @@ -562,13 +616,18 @@ sub transaction { $sth->finish; # retrieve individual rows - $query = "SELECT c.accno, c.taxkey_id AS accnotaxkey, a.amount, project_id, - (SELECT p.projectnumber FROM project p - WHERE a.project_id = p.id) AS projectnumber, a.taxkey, (SELECT c1.accno FROM chart c1, tax t WHERE t.taxkey=a.taxkey AND c1.id=t.chart_id) AS taxaccno, (SELECT t1.rate FROM tax t1 WHERE t1.taxkey=a.taxkey) AS taxrate - FROM acc_trans a, chart c - WHERE a.chart_id = c.id - AND a.trans_id = $form->{id} - ORDER BY a.oid"; + $query = qq|SELECT c.accno, t.taxkey AS accnotaxkey, a.amount, a.memo, + a.transdate, a.cleared, a.project_id, p.projectnumber,(SELECT p.projectnumber FROM project p + WHERE a.project_id = p.id) AS projectnumber, a.taxkey, t.rate AS taxrate, t.id, (SELECT c1.accno FROM chart c1, tax t1 WHERE t1.id=t.id AND c1.id=t.chart_id) AS taxaccno, t.id AS tax_id + FROM acc_trans a + JOIN chart c ON (c.id = a.chart_id) + LEFT JOIN project p ON (p.id = a.project_id) + LEFT JOIN tax t ON (t.id=(SELECT tk.tax_id from taxkeys tk WHERE (tk.taxkey_id=a.taxkey) AND ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id=a.taxkey) THEN tk.chart_id=a.chart_id ELSE 1=1 END) OR (c.link='%tax%')) AND startdate <=a.transdate ORDER BY startdate DESC LIMIT 1)) + WHERE a.trans_id = $form->{id} + AND a.fx_transaction = '0' + ORDER BY a.oid,a.transdate|; + + $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -606,12 +665,15 @@ sub transaction { } $sth->finish; - + my $transdate = "current_date"; + if ($form->{transdate}) { + $transdate = qq|'$form->{transdate}'|; + } # get chart of accounts - $query = qq|SELECT c.accno, c.description, c.taxkey_id - FROM chart c - WHERE c.charttype = 'A' - ORDER by c.accno|; + $query = qq|SELECT c.accno, c.description, c.link, tk.taxkey_id, tk.tax_id + FROM chart c + LEFT JOIN taxkeys tk ON (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 || $form->dberror($query); $form->{chart} = (); diff --git a/SL/IC.pm b/SL/IC.pm index eaa5e880b..961c639bf 100644 --- a/SL/IC.pm +++ b/SL/IC.pm @@ -193,6 +193,16 @@ sub get_part { } } + # get translations + $form->{language_values} = ""; + $query = qq|SELECT language_id, translation FROM translation WHERE parts_id = $form->{id}|; + $trq = $dbh->prepare($query); + $trq->execute || $form->dberror($query); + while ($tr = $trq->fetchrow_hashref(NAME_lc)) { + $form->{language_values} .= "---+++---".$tr->{language_id}."--++--".$tr->{translation}; + } + $trq->finish; + # now get accno for taxes $query = qq|SELECT c.accno FROM chart c, partstax pt @@ -227,6 +237,18 @@ sub get_part { $form->{orphaned} = !$form->{orphaned}; $sth->finish; + $form->{"unit_changeable"} = 1; + foreach my $table (qw(invoice assembly orderitems inventory license)) { + $query = "SELECT COUNT(*) FROM $table WHERE parts_id = ?"; + my ($count) = $dbh->selectrow_array($query, undef, $form->{"id"}); + $form->dberror($query . " (" . $form->{"id"} . ")") if ($dbh->err); + + if ($count) { + $form->{"unit_changeable"} = 0; + last; + } + } + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -277,12 +299,38 @@ sub get_pricegroups { $main::lxdebug->leave_sub(); } +sub retrieve_buchungsgruppen { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + my ($query, $sth); + + my $dbh = $form->dbconnect($myconfig); + + # get buchungsgruppen + $query = qq|SELECT id, description + FROM buchungsgruppen|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{BUCHUNGSGRUPPEN} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{ $form->{BUCHUNGSGRUPPEN} }, $ref); + } + $sth->finish; + + $main::lxdebug->leave_sub(); +} + sub save { $main::lxdebug->enter_sub(); my ($self, $myconfig, $form) = @_; + $form->{IC_expense} = "1000"; + $form->{IC_income} = "2000"; - if ($form->{eur} && ($form->{item} ne 'service')) { + if ($form->{item} ne 'service') { $form->{IC} = $form->{IC_expense}; } @@ -322,6 +370,9 @@ sub save { $form->{onhand} *= 1; $form->{ve} *= 1; $form->{ge} *= 1; + $form->{buchungsgruppen_id} *= 1; + $form->{not_discountable} *= 1; + $form->{payment_id} *= 1; my ($query, $sth); @@ -373,6 +424,11 @@ sub save { WHERE parts_id = $form->{id}|; $dbh->do($query) || $form->dberror($query); + # delete translations + $query = qq|DELETE FROM translation + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } else { my $uid = rand() . time; $uid .= $form->{login}; @@ -429,8 +485,11 @@ sub save { priceupdate = $form->{priceupdate}, unit = '$form->{unit}', notes = '$form->{notes}', + formel = '$form->{formel}', rop = $form->{rop}, bin = '$form->{bin}', + buchungsgruppen_id = '$form->{buchungsgruppen_id}', + payment_id = '$form->{payment_id}', inventory_accno_id = (SELECT c.id FROM chart c WHERE c.accno = '$form->{inventory_accno}'), income_accno_id = (SELECT c.id FROM chart c @@ -443,16 +502,32 @@ sub save { shop = '$form->{shop}', ve = '$form->{ve}', gv = '$form->{gv}', + not_discountable = '$form->{not_discountable}', microfiche = '$form->{microfiche}', partsgroup_id = $partsgroup_id WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); + # delete translation records + $query = qq|DELETE FROM translation + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + if ($form->{language_values} ne "") { + split /---\+\+\+---/,$form->{language_values}; + foreach $item (@_) { + my ($language_id, $translation, $longdescription) = split /--\+\+--/, $item; + if ($translation ne "") { + $query = qq|INSERT into translation (parts_id, language_id, translation, longdescription) VALUES + ($form->{id}, $language_id, | . $dbh->quote($translation) . qq|, | . $dbh->quote($longdescription) . qq| )|; + $dbh->do($query) || $form->dberror($query); + } + } + } # delete price records $query = qq|DELETE FROM prices WHERE parts_id = $form->{id}|; $dbh->do($query) || $form->dberror($query); - # insert price records only if different to sellprice for my $i (1 .. $form->{price_rows}) { if ($form->{"price_$i"} eq "0") { @@ -718,6 +793,11 @@ sub delete { # connect to database, turn off AutoCommit my $dbh = $form->dbconnect_noauto($myconfig); + # first delete prices of pricegroup + my $query = qq|DELETE FROM prices + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + my $query = qq|DELETE FROM parts WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); @@ -825,14 +905,10 @@ sub all_parts { my $group; my $limit; - foreach my $item (qw(partnumber drawing microfiche make model)) { + foreach my $item (qw(partnumber drawing microfiche)) { if ($form->{$item}) { $var = $form->like(lc $form->{$item}); - - # make will build later Bugfix 145 - if ($item ne 'make') { - $where .= " AND lower(p.$item) LIKE '$var'"; - } + $where .= " AND lower(p.$item) LIKE '$var'"; } } @@ -1000,7 +1076,7 @@ sub all_parts { p.priceupdate, p.image, p.drawing, p.microfiche, pg.partsgroup, a.invnumber, a.ordnumber, a.quonumber, i.trans_id, - ct.name|; + ct.name, i.deliverydate|; if ($form->{bought}) { $query = qq| @@ -1207,6 +1283,171 @@ sub all_parts { $main::lxdebug->leave_sub(); } +sub update_prices { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + my $where = '1 = 1'; + my $var; + + my $group; + my $limit; + + foreach my $item (qw(partnumber drawing microfiche make model)) { + if ($form->{$item}) { + $var = $form->like(lc $form->{$item}); + + # make will build later Bugfix 145 + if ($item ne 'make') { + $where .= " AND lower(p.$item) LIKE '$var'"; + } + } + } + + # special case for description + if ($form->{description}) { + unless ( $form->{bought} + || $form->{sold} + || $form->{onorder} + || $form->{ordered} + || $form->{rfq} + || $form->{quoted}) { + $var = $form->like(lc $form->{description}); + $where .= " AND lower(p.description) LIKE '$var'"; + } + } + + # special case for serialnumber + if ($form->{l_serialnumber}) { + if ($form->{serialnumber}) { + $var = $form->like(lc $form->{serialnumber}); + $where .= " AND lower(serialnumber) LIKE '$var'"; + } + } + + + # items which were never bought, sold or on an order + if ($form->{itemstatus} eq 'orphaned') { + $form->{onhand} = $form->{short} = 0; + $form->{bought} = $form->{sold} = 0; + $form->{onorder} = $form->{ordered} = 0; + $form->{rfq} = $form->{quoted} = 0; + + $form->{transdatefrom} = $form->{transdateto} = ""; + + $where .= " AND p.onhand = 0 + AND p.id NOT IN (SELECT p.id FROM parts p, invoice i + WHERE p.id = i.parts_id) + AND p.id NOT IN (SELECT p.id FROM parts p, assembly a + WHERE p.id = a.parts_id) + AND p.id NOT IN (SELECT p.id FROM parts p, orderitems o + WHERE p.id = o.parts_id)"; + } + + if ($form->{itemstatus} eq 'active') { + $where .= " AND p.obsolete = '0'"; + } + if ($form->{itemstatus} eq 'obsolete') { + $where .= " AND p.obsolete = '1'"; + $form->{onhand} = $form->{short} = 0; + } + if ($form->{itemstatus} eq 'onhand') { + $where .= " AND p.onhand > 0"; + } + if ($form->{itemstatus} eq 'short') { + $where .= " AND p.onhand < p.rop"; + } + if ($form->{make}) { + $var = $form->like(lc $form->{make}); + $where .= " AND p.id IN (SELECT DISTINCT ON (m.parts_id) m.parts_id + FROM makemodel m WHERE lower(m.make) LIKE '$var')"; + } + if ($form->{model}) { + $var = $form->like(lc $form->{model}); + $where .= " AND p.id IN (SELECT DISTINCT ON (m.parts_id) m.parts_id + FROM makemodel m WHERE lower(m.model) LIKE '$var')"; + } + if ($form->{partsgroup}) { + $var = $form->like(lc $form->{partsgroup}); + $where .= " AND lower(pg.partsgroup) LIKE '$var'"; + } + + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + if ($form->{"sellprice"} ne "") { + my $update = ""; + my $faktor = $form->parse_amount($myconfig,$form->{"sellprice"}); + if ($form->{"sellprice_type"} eq "percent") { + my $faktor = $form->parse_amount($myconfig,$form->{"sellprice"})/100 +1; + $update = "sellprice* $faktor"; + } else { + $update = "sellprice+$faktor"; + } + + $query = qq|UPDATE parts set sellprice=$update WHERE id IN (SELECT p.id + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE $where)|; + $dbh->do($query); + } + + if ($form->{"listprice"} ne "") { + my $update = ""; + my $faktor = $form->parse_amount($myconfig,$form->{"listprice"}); + if ($form->{"listprice_type"} eq "percent") { + my $faktor = $form->parse_amount($myconfig,$form->{"sellprice"})/100 +1; + $update = "listprice* $faktor"; + } else { + $update = "listprice+$faktor"; + } + + $query = qq|UPDATE parts set listprice=$update WHERE id IN (SELECT p.id + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE $where)|; + + $dbh->do($query); + } + + + + + for my $i (1 .. $form->{price_rows}) { + + my $query = ""; + + + if ($form->{"price_$i"} ne "") { + my $update = ""; + my $faktor = $form->parse_amount($myconfig,$form->{"price_$i"}); + if ($form->{"pricegroup_type_$i"} eq "percent") { + my $faktor = $form->parse_amount($myconfig,$form->{"sellprice"})/100 +1; + $update = "price* $faktor"; + } else { + $update = "price+$faktor"; + } + + $query = qq|UPDATE prices set price=$update WHERE parts_id IN (SELECT p.id + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE $where) AND pricegroup_id=$form->{"pricegroup_id_$i"}|; + + $dbh->do($query); + } + } + + + + my $rc= $dbh->commit; + $dbh->disconnect; + $main::lxdebug->leave_sub(); + + return $rc; +} + sub create_links { $main::lxdebug->enter_sub(); @@ -1242,6 +1483,7 @@ sub create_links { { accno => $ref->{accno}, description => $ref->{description}, selected => "selected" }; + $form->{"${key}_default"} = "$ref->{accno}--$ref->{description}"; } else { push @{ $form->{"${module}_links"}{$key} }, { accno => $ref->{accno}, @@ -1253,6 +1495,30 @@ sub create_links { } $sth->finish; + # get buchungsgruppen + $query = qq|SELECT id, description + FROM buchungsgruppen|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{BUCHUNGSGRUPPEN} = []; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{BUCHUNGSGRUPPEN} }, $ref; + } + $sth->finish; + + # get payment terms + $query = qq|SELECT id, description + FROM payment_terms + ORDER BY 1|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{payment_terms} }, $ref; + } + $sth->finish; + if ($form->{id}) { $query = qq|SELECT weightunit FROM defaults|; @@ -1432,4 +1698,177 @@ sub retrieve_item { $main::lxdebug->leave_sub(); } +sub retrieve_languages { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + if ($form->{id}) { + $where .= "tr.parts_id=$form->{id}"; + } + + + if ($form->{language_values} ne "") { + $query = qq|SELECT l.id, l.description, tr.translation, tr.longdescription + FROM language l LEFT OUTER JOIN translation tr ON (tr.language_id=l.id AND $where)|; + } else { + $query = qq|SELECT l.id, l.description + FROM language l|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{$languages}, $ref); + } + $sth->finish; + + $dbh->disconnect; + + $main::lxdebug->leave_sub(); + return $languages; + +} + +sub follow_account_chain { + $main::lxdebug->enter_sub(); + + my ($self, $form, $dbh, $transdate, $accno_id, $accno) = @_; + + my @visited_accno_ids = ($accno_id); + + my ($query, $sth); + + $query = + "SELECT c.new_chart_id, date($transdate) >= c.valid_from AS is_valid, " . + " cnew.accno " . + "FROM chart c " . + "LEFT JOIN chart cnew ON c.new_chart_id = cnew.id " . + "WHERE (c.id = ?) AND NOT c.new_chart_id ISNULL AND (c.new_chart_id > 0)"; + $sth = $dbh->prepare($query); + + while (1) { + $sth->execute($accno_id) || $form->dberror($query . " ($accno_id)"); + $ref = $sth->fetchrow_hashref(); + last unless ($ref && $ref->{"is_valid"} && + !grep({ $_ == $ref->{"new_chart_id"} } @visited_accno_ids)); + $accno_id = $ref->{"new_chart_id"}; + $accno = $ref->{"accno"}; + push(@visited_accno_ids, $accno_id); + } + + $main::lxdebug->leave_sub(); + + return ($accno_id, $accno); +} + +sub retrieve_accounts { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $parts_id, $index, $copy_accnos) = @_; + + my ($query, $sth, $dbh); + + return $main::lxdebug->leave_sub() if (!defined($form->{"taxzone_id"})); + + $dbh = $form->dbconnect($myconfig); + + my $transdate = ""; + if ($form->{type} eq "invoice") { + if (($form->{vc} eq "vendor") || !$form->{deliverydate}) { + $transdate = $form->{invdate}; + } else { + $transdate = $form->{deliverydate}; + } + } else { + $transdate = $form->{transdate}; + } + + if ($transdate eq "") { + $transdate = "current_date"; + } else { + $transdate = $dbh->quote($transdate); + } + + $query = + "SELECT " . + " p.inventory_accno_id AS is_part, " . + " bg.inventory_accno_id, " . + " bg.income_accno_id_$form->{taxzone_id} AS income_accno_id, " . + " bg.expense_accno_id_$form->{taxzone_id} AS expense_accno_id, " . + " c1.accno AS inventory_accno, " . + " c2.accno AS income_accno, " . + " c3.accno AS expense_accno " . + "FROM parts p " . + "LEFT JOIN buchungsgruppen bg ON p.buchungsgruppen_id = bg.id " . + "LEFT JOIN chart c1 ON bg.inventory_accno_id = c1.id " . + "LEFT JOIN chart c2 ON bg.income_accno_id_$form->{taxzone_id} = c2.id " . + "LEFT JOIN chart c3 ON bg.expense_accno_id_$form->{taxzone_id} = c3.id " . + "WHERE p.id = ?"; + $sth = $dbh->prepare($query); + $sth->execute($parts_id) || $form->dberror($query . " ($parts_id)"); + my $ref = $sth->fetchrow_hashref(); + $sth->finish(); + +# $main::lxdebug->message(0, "q $query"); + + if (!$ref) { + $dbh->disconnect(); + return $lxdebug->leave_sub(); + } + + $ref->{"inventory_accno_id"} = undef unless ($ref->{"is_part"}); + + my %accounts; + foreach my $type (qw(inventory income expense)) { + next unless ($ref->{"${type}_accno_id"}); + ($accounts{"${type}_accno_id"}, $accounts{"${type}_accno"}) = + $self->follow_account_chain($form, $dbh, $transdate, + $ref->{"${type}_accno_id"}, + $ref->{"${type}_accno"}); + } + + map({ $form->{"${_}_accno_$index"} = $accounts{"${_}_accno"} } + qw(inventory income expense)); + + my $inc_exp = $form->{"vc"} eq "customer" ? "income" : "expense"; + my $accno_id = $accounts{"${inc_exp}_accno_id"}; + + $query = + "SELECT c.accno, t.taxdescription AS description, t.rate, t.taxnumber " . + "FROM tax t " . + "LEFT JOIN chart c ON c.id = t.chart_id " . + "WHERE t.id IN " . + " (SELECT tk.tax_id " . + " FROM taxkeys tk " . + " WHERE tk.chart_id = $accno_id AND startdate <= $transdate " . + " ORDER BY startdate DESC LIMIT 1) "; + $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); + $ref = $sth->fetchrow_hashref(); + $sth->finish(); + $dbh->disconnect(); + + return $lxdebug->leave_sub() unless ($ref); + + $form->{"taxaccounts_$index"} = $ref->{"accno"}; + if ($form->{"taxaccounts"} !~ /$ref->{accno}/) { + $form->{"taxaccounts"} .= "$ref->{accno} "; + } + map({ $form->{"$ref->{accno}_${_}"} = $ref->{$_}; } + qw(rate description taxnumber)); + +# $main::lxdebug->message(0, "formvars: rate " . $form->{"$ref->{accno}_rate"} . +# " description " . $form->{"$ref->{accno}_description"} . +# " taxnumber " . $form->{"$ref->{accno}_taxnumber"} . +# " || taxaccounts_$index " . $form->{"taxaccounts_$index"} . +# " || taxaccounts " . $form->{"taxaccounts"}); + + $sth->finish(); + + $main::lxdebug->leave_sub(); +} 1; diff --git a/SL/IR.pm b/SL/IR.pm index 5c243a468..77df80603 100644 --- a/SL/IR.pm +++ b/SL/IR.pm @@ -34,6 +34,8 @@ package IR; +use SL::AM; + sub post_invoice { $main::lxdebug->enter_sub(); @@ -50,6 +52,9 @@ sub post_invoice { my $taxdiff; my $item; + my $service_units = AM->retrieve_units($myconfig,$form,"service"); + my $part_units = AM->retrieve_units($myconfig,$form,"dimension"); + if ($form->{id}) { &reverse_invoice($dbh, $form); @@ -98,9 +103,39 @@ sub post_invoice { for my $i (1 .. $form->{rowcount}) { $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); - + + if ($form->{storno}) { + $form->{"qty_$i"} *= -1; + } + if ($form->{"qty_$i"} != 0) { + # get item baseunit + $query = qq|SELECT p.unit + FROM parts p + WHERE p.id = $form->{"id_$i"}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($item_unit) = $sth->fetchrow_array(); + $sth->finish; + + if ($form->{"inventory_accno_$i"}) { + if (defined($part_units->{$item_unit}->{factor}) && $part_units->{$item_unit}->{factor} ne '' && $part_units->{$item_unit}->{factor} ne '0') { + $basefactor = $part_units->{$form->{"unit_$i"}}->{factor} / $part_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } else { + if (defined($service_units->{$item_unit}->{factor}) && $service_units->{$item_unit}->{factor} ne '' && $service_units->{$item_unit}->{factor} ne '0') { + $basefactor = $service_units->{$form->{"unit_$i"}}->{factor} / $service_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } + map { $form->{"${_}_$i"} =~ s/\'/\'\'/g } qw(partnumber description unit); @@ -186,7 +221,7 @@ sub post_invoice { $form->update_balance($dbh, "parts", "onhand", qq|id = $form->{"id_$i"}|, - $form->{"qty_$i"}) + $baseqty) unless $form->{shipped}; # check if we sold the item already and @@ -196,23 +231,23 @@ sub post_invoice { FROM invoice i, ar a, parts p WHERE i.parts_id = p.id AND i.parts_id = $form->{"id_$i"} - AND (i.qty + i.allocated) > 0 + AND (i.base_qty + i.allocated) > 0 AND i.trans_id = a.id ORDER BY transdate|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); - my $totalqty = $form->{"qty_$i"}; + my $totalqty = $base_qty; while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - my $qty = $ref->{qty} + $ref->{allocated}; + my $qty = $ref->{base_qty} + $ref->{allocated}; if (($qty - $totalqty) > 0) { $qty = $totalqty; } - $linetotal = $form->round_amount($form->{"sellprice_$i"} * $qty, 2); + $linetotal = $form->round_amount(($form->{"sellprice_$i"} * $qty) / $basefactor, 2); if ($ref->{allocated} < 0) { @@ -343,11 +378,11 @@ sub post_invoice { : "NULL"; # save detail record in invoice table - $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty, + $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty, base_qty, sellprice, fxsellprice, allocated, unit, deliverydate, project_id, serialnumber) VALUES ($form->{id}, $form->{"id_$i"}, - '$form->{"description_$i"}', | . ($form->{"qty_$i"} * -1) . qq|, + '$form->{"description_$i"}', | . ($form->{"qty_$i"} * -1) . qq|, | . ($baseqty * -1) . qq|, $form->{"sellprice_$i"}, $fxsellprice, $allocated, '$form->{"unit_$i"}', $deliverydate, (SELECT id FROM project WHERE projectnumber = '$project_id'), '$form->{"serialnumber_$i"}')|; @@ -571,6 +606,11 @@ sub post_invoice { ($null, $form->{department_id}) = split(/--/, $form->{department}); $form->{department_id} *= 1; + $form->{payment_id} *= 1; + $form->{language_id} *= 1; + $form->{taxzone_id} *= 1; + $form->{storno} *= 1; + $form->{invnumber} = $form->{id} unless $form->{invnumber}; @@ -587,19 +627,34 @@ sub post_invoice { datepaid = $datepaid, duedate = $duedate, invoice = '1', + taxzone_id = '$form->{taxzone_id}', taxincluded = '$form->{taxincluded}', notes = '$form->{notes}', intnotes = '$form->{intnotes}', curr = '$form->{currency}', department_id = $form->{department_id}, + storno = '$form->{storno}', cp_id = $form->{contact_id} WHERE id = $form->{id}|; $dbh->do($query) || $form->dberror($query); + if ($form->{storno}) { + $query = qq| update ap set paid=paid+amount where id=$form->{storno_id}|; + $dbh->do($query) || $form->dberror($query); + $query = qq| update ap set storno='$form->{storno}' where id=$form->{storno_id}|; + $dbh->do($query) || $form->dberror($query); + $query = qq§ update ap set intnotes='Rechnung storniert am $form->{invdate} ' || intnotes where id=$form->{storno_id}§; + $dbh->do($query) || $form->dberror($query); + + $query = qq| update ap set paid=amount where id=$form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + # add shipto $form->{name} = $form->{vendor}; $form->{name} =~ s/--$form->{vendor_id}//; - $form->add_shipto($dbh, $form->{id}); + $form->add_shipto($dbh, $form->{id}, "AP"); # delete zero entries $query = qq|DELETE FROM acc_trans @@ -701,7 +756,7 @@ sub reverse_invoice { $dbh->do($query) || $form->dberror($query); $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; + WHERE trans_id = $form->{id} AND module = 'AP'|; $dbh->do($query) || $form->dberror($query); $main::lxdebug->leave_sub(); @@ -786,7 +841,7 @@ sub retrieve_invoice { # retrieve invoice $query = qq|SELECT a.cp_id, a.invnumber, a.transdate AS invdate, a.duedate, - a.ordnumber, a.quonumber, a.paid, a.taxincluded, a.notes, + a.ordnumber, a.quonumber, a.paid, a.taxincluded, a.notes, a.taxzone_id, a.storno, a.gldate, a.intnotes, a.curr AS currency FROM ap a WHERE a.id = $form->{id}|; @@ -803,28 +858,35 @@ sub retrieve_invoice { # get shipto $query = qq|SELECT s.* FROM shipto s - WHERE s.trans_id = $form->{id}|; + WHERE s.trans_id = $form->{id} AND s.module = 'AP'|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); $ref = $sth->fetchrow_hashref(NAME_lc); + delete($ref->{id}); map { $form->{$_} = $ref->{$_} } keys %$ref; $sth->finish; + my $transdate = + $form->{invdate} ? $dbh->quote($form->{invdate}) : "current_date"; + + if(!$form->{taxzone_id}) { + $form->{taxzone_id} = 0; + } # retrieve individual items - $query = qq|SELECT c1.accno AS inventory_accno, - c2.accno AS income_accno, - c3.accno AS expense_accno, - p.partnumber, i.description, i.qty, i.fxsellprice AS sellprice, + $query = qq|SELECT c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid, + c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid, + c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from as expense_valid, + p.partnumber, i.description, i.qty, i.fxsellprice AS sellprice, p.inventory_accno_id AS part_inventory_accno_id, i.parts_id AS id, i.unit, p.bin, i.deliverydate, pr.projectnumber, i.project_id, i.serialnumber, pg.partsgroup FROM invoice i JOIN parts p ON (i.parts_id = p.id) - LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) - LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) - LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN chart c1 ON ((select inventory_accno_id from buchungsgruppen where id=p.buchungsgruppen_id) = c1.id) + LEFT JOIN chart c2 ON ((select income_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c2.id) + LEFT JOIN chart c3 ON ((select expense_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c3.id) LEFT JOIN project pr ON (i.project_id = pr.id) LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) WHERE i.trans_id = $form->{id} @@ -833,34 +895,57 @@ sub retrieve_invoice { $sth->execute || $form->dberror($query); while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - - #set expense_accno=inventory_accno if they are different => bilanz - $vendor_accno = - ($ref->{expense_accno} != $ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; - $vendor_accno = - ($ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; + if (!$ref->{"part_inventory_accno_id"}) { + map({ delete($ref->{$_}); } qw(inventory_accno inventory_new_chart inventory_valid)); + } + delete($ref->{"part_inventory_accno_id"}); + + while ($ref->{inventory_new_chart} && ($ref->{inventory_valid} >=0)) { + my $query = qq| SELECT accno AS inventory_accno, new_chart_id AS inventory_new_chart, date($transdate) - valid_from AS inventory_valid FROM chart WHERE id = $ref->{inventory_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{inventory_accno}, $ref->{inventory_new_chart}, $ref->{inventory_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{income_new_chart} && ($ref->{income_valid} >=0)) { + my $query = qq| SELECT accno AS income_accno, new_chart_id AS income_new_chart, date($transdate) - valid_from AS income_valid FROM chart WHERE id = $ref->{income_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{income_accno}, $ref->{income_new_chart}, $ref->{income_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{expense_new_chart} && ($ref->{expense_valid} >=0)) { + my $query = qq| SELECT accno AS expense_accno, new_chart_id AS expense_new_chart, date($transdate) - valid_from AS expense_valid FROM chart WHERE id = $ref->{expense_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{expense_accno}, $ref->{expense_new_chart}, $ref->{expense_valid}) = $stw->fetchrow_array; + $stw->finish; + } # get tax rates and description $accno_id = - ($form->{vc} eq "customer") ? $ref->{income_accno} : $vendor_accno; - $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber - FROM chart c, tax t - WHERE c.id=t.chart_id AND t.taxkey in (SELECT taxkey_id from chart where accno = '$accno_id') - ORDER BY accno|; + ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno}; + $query = qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id in (SELECT tk.tax_id from taxkeys tk where tk.chart_id = (SELECT id from chart WHERE accno='$accno_id') AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) + ORDER BY c.accno|; $stw = $dbh->prepare($query); $stw->execute || $form->dberror($query); $ref->{taxaccounts} = ""; + my $i = 0; while ($ptr = $stw->fetchrow_hashref(NAME_lc)) { # if ($customertax{$ref->{accno}}) { + if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) { + $i++; + $ptr->{accno} = $i; + } $ref->{taxaccounts} .= "$ptr->{accno} "; if (!($form->{taxaccounts} =~ /$ptr->{accno}/)) { $form->{"$ptr->{accno}_rate"} = $ptr->{rate}; - $form->{"$ptr->{accno}_description"} = $ptr->{description}; + $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription}; $form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; $form->{taxaccounts} .= "$ptr->{accno} "; } @@ -907,9 +992,9 @@ sub get_vendor { # get vendor my $query = qq|SELECT v.name AS vendor, v.creditlimit, v.terms, - v.email, v.cc, v.bcc, v.language, - v.street, v.zipcode, v.city, v.country, - $duedate + v.terms AS duedate, v.notes AS intnotes + v.email, v.cc, v.bcc, v.language_id, v.payment_id, + v.street, v.zipcode, v.city, v.country, v.taxzone_id, + $duedate + v.terms AS duedate FROM vendor v WHERE v.id = $form->{vendor_id}|; my $sth = $dbh->prepare($query); @@ -962,7 +1047,7 @@ sub get_vendor { qw(shiptoname shiptostreet shiptozipcode shiptocity shiptocountry shiptocontact shiptophone shiptofax shiptoemail); $query = qq|SELECT s.* FROM shipto s - WHERE s.trans_id = $form->{vendor_id}|; + WHERE s.trans_id = $form->{vendor_id} AND s.module= 'CT'|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -1024,6 +1109,9 @@ sub retrieve_item { my ($self, $myconfig, $form) = @_; + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $i = $form->{rowcount}; # don't include assemblies or obsolete parts @@ -1050,19 +1138,26 @@ sub retrieve_item { $where .= " ORDER BY p.partnumber"; } - # connect to database - my $dbh = $form->dbconnect($myconfig); + my $transdate = ""; + if ($form->{type} eq "invoice") { + $transdate = + $form->{invdate} ? $dbh->quote($form->{invdate}) : "current_date"; + } else { + $transdate = + $form->{transdate} ? $dbh->quote($form->{transdate}) : "current_date"; + } - my $query = qq|SELECT p.id, p.partnumber, p.description, - c1.accno AS inventory_accno, - c2.accno AS income_accno, - c3.accno AS expense_accno, - pg.partsgroup, - p.lastcost AS sellprice, p.unit, p.bin, p.onhand, p.notes AS partnotes + my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, + p.listprice, p.inventory_accno_id, + c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid, + c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid, + c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from as expense_valid, + p.unit, p.assembly, p.bin, p.onhand, p.notes AS partnotes, p.notes AS longdescription, p.not_discountable, + pg.partsgroup, p.formel FROM parts p - LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) - LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) - LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN chart c1 ON ((select inventory_accno_id from buchungsgruppen where id=p.buchungsgruppen_id) = c1.id) + LEFT JOIN chart c2 ON ((select income_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c2.id) + LEFT JOIN chart c3 ON ((select expense_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c3.id) LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) WHERE $where|; my $sth = $dbh->prepare($query); @@ -1070,34 +1165,37 @@ sub retrieve_item { while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - #set expense_accno=inventory_accno if they are different => bilanz - $vendor_accno = - ($ref->{expense_accno} != $ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; - $vendor_accno = - ($ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; + # In der Buchungsgruppe ist immer ein Bestandskonto verknuepft, auch wenn + # es sich um eine Dienstleistung handelt. Bei Dienstleistungen muss das + # Buchungskonto also aus dem Ergebnis rausgenommen werden. + if (!$ref->{inventory_accno_id}) { + map({ delete($ref->{"inventory_${_}"}); } qw(accno new_chart valid)); + } + delete($ref->{inventory_accno_id}); # get tax rates and description $accno_id = - ($form->{vc} eq "customer") ? $ref->{income_accno} : $vendor_accno; - $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber - FROM chart c, tax t - WHERE c.id=t.chart_id AND t.taxkey in (SELECT taxkey_id from chart where accno = '$accno_id') + ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno}; + $query = qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id in (SELECT tk.tax_id from taxkeys tk where tk.chart_id = (SELECT id from chart WHERE accno='$accno_id') AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) ORDER BY c.accno|; $stw = $dbh->prepare($query); $stw->execute || $form->dberror($query); $ref->{taxaccounts} = ""; + my $i = 0; while ($ptr = $stw->fetchrow_hashref(NAME_lc)) { # if ($customertax{$ref->{accno}}) { + if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) { + $i++; + $ptr->{accno} = $i; + } $ref->{taxaccounts} .= "$ptr->{accno} "; if (!($form->{taxaccounts} =~ /$ptr->{accno}/)) { $form->{"$ptr->{accno}_rate"} = $ptr->{rate}; - $form->{"$ptr->{accno}_description"} = $ptr->{description}; + $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription}; $form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; $form->{taxaccounts} .= "$ptr->{accno} "; } @@ -1216,4 +1314,142 @@ SWITCH: { $main::lxdebug->leave_sub(); } +sub post_payment { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $locale) = @_; + + # connect to database, turn off autocommit + my $dbh = $form->dbconnect_noauto($myconfig); + + $form->{datepaid} = $form->{invdate}; + + # total payments, don't move we need it here + for my $i (1 .. $form->{paidaccounts}) { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"}); + } + + $form->{exchangerate} = + $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, + "buy"); + + # record payments and offsetting AP + for my $i (1 .. $form->{paidaccounts}) { + + if ($form->{"paid_$i"} != 0) { + my ($accno) = split /--/, $form->{"AP_paid_$i"}; + $form->{"datepaid_$i"} = $form->{invdate} + unless ($form->{"datepaid_$i"}); + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + if (($form->{currency} eq $form->{defaultcurrency}) || ($form->{defaultcurrency} eq "")) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = + $form->check_exchangerate($myconfig, $form->{currency}, + $form->{"datepaid_$i"}, 'buy'); + + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + # record AP + $amount = + $form->round_amount($form->{"paid_$i"} * $form->{"exchangerate"}, + 2) * -1; + + + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$form->{AP}') AND amount=$amount AND transdate='$form->{"datepaid_$i"}'|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$form->{AP}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + + + + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$accno') AND amount=$form->{"paid_$i"} AND transdate='$form->{"datepaid_$i"}' AND source='$form->{"source_$i"}' AND memo='$form->{"memo_$i"}'|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, memo) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$accno'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', + '$form->{"source_$i"}', '$form->{"memo_$i"}')|; + $dbh->do($query) || $form->dberror($query); + + + # gain/loss + $amount = + $form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} * + $form->{"exchangerate_$i"}; + if ($amount > 0) { + $form->{fx}{ $form->{fxgain_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } else { + $form->{fx}{ $form->{fxloss_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } + + $diff = 0; + + # update exchange rate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, + $form->{"datepaid_$i"}, + $form->{"exchangerate_$i"}, 0); + } + } + } + + # record exchange rate differences and gains/losses + foreach my $accno (keys %{ $form->{fx} }) { + foreach my $transdate (keys %{ $form->{fx}{$accno} }) { + if ( + ($form->{fx}{$accno}{$transdate} = + $form->round_amount($form->{fx}{$accno}{$transdate}, 2) + ) != 0 + ) { + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$accno') AND amount=$form->{fx}{$accno}{$transdate} AND transdate='$transdate' AND cleared='0' AND fx_transaction='1'|; + $dbh->do($query) || $form->dberror($query); + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, cleared, fx_transaction) + VALUES ($form->{id}, + (SELECT c.id FROM chart c + WHERE c.accno = '$accno'), + $form->{fx}{$accno}{$transdate}, '$transdate', '0', '1')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL"; + + # save AP record + my $query = qq|UPDATE ap set + paid = $form->{paid}, + datepaid = $datepaid + WHERE id=$form->{id}|; + + $dbh->do($query) || $form->dberror($query); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); + + return $rc; +} + 1; diff --git a/SL/IS.pm b/SL/IS.pm index d4d8c6f1d..7df695efb 100644 --- a/SL/IS.pm +++ b/SL/IS.pm @@ -35,6 +35,7 @@ package IS; use Data::Dumper; +use SL::AM; sub invoice_details { $main::lxdebug->enter_sub(); @@ -67,7 +68,6 @@ sub invoice_details { for $i (1 .. $form->{rowcount}) { $partsgroup = ""; if ($form->{"partsgroup_$i"} && $form->{groupitems}) { - $form->format_string("partsgroup_$i"); $partsgroup = $form->{"partsgroup_$i"}; } push @partsgroup, [$i, $partsgroup]; @@ -81,6 +81,14 @@ sub invoice_details { my $taxamount; my $taxbase; my $taxdiff; + my $nodiscount; + my $yesdiscount; + my $nodiscount_subtotal = 0; + my $discount_subtotal = 0; + my $position = 0; + my $subtotal_header = 0; + my $subposition = 0; + foreach $item (sort { $a->[1] cmp $b->[1] } @partsgroup) { $i = $item->[0]; @@ -97,13 +105,27 @@ sub invoice_details { if ($form->{"qty_$i"} != 0) { - # add number, description and qty to $form->{number}, .... - push(@{ $form->{runningnumber} }, $i); + # add number, description and qty to $form->{number}, + if ($form->{"subtotal_$i"} && !$subtotal_header) { + $subtotal_header = $i; + $position = int($position); + $subposition = 0; + $position++; + } elsif ($subtotal_header) { + $subposition += 1; + $position = int($position); + $position = $position.".".$subposition; + } else { + $position = int($position); + $position++; + } + push(@{ $form->{runningnumber} }, $position); push(@{ $form->{number} }, qq|$form->{"partnumber_$i"}|); push(@{ $form->{serialnumber} }, qq|$form->{"serialnumber_$i"}|); push(@{ $form->{bin} }, qq|$form->{"bin_$i"}|); push(@{ $form->{"partnotes"} }, qq|$form->{"partnotes_$i"}|); push(@{ $form->{description} }, qq|$form->{"description_$i"}|); + push(@{ $form->{longdescription} }, qq|$form->{"longdescription_$i"}|); push(@{ $form->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"})); push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|); @@ -112,6 +134,8 @@ sub invoice_details { push(@{ $form->{sellprice} }, $form->{"sellprice_$i"}); push(@{ $form->{ordnumber_oe} }, qq|$form->{"ordnumber_$i"}|); push(@{ $form->{transdate_oe} }, qq|$form->{"transdate_$i"}|); + push(@{ $form->{invnumber} }, qq|$form->{"invnumber"}|); + push(@{ $form->{invdate} }, qq|$form->{"invdate"}|); if ($form->{lizenzen}) { if ($form->{"licensenumber_$i"}) { @@ -162,6 +186,9 @@ sub invoice_details { my $linetotal = $form->round_amount($form->{"qty_$i"} * $form->{"netprice_$i"}, 2); + my $nodiscount_linetotal = + $form->round_amount($form->{"qty_$i"} * $sellprice, 2); + $discount = ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, $decimalplaces) @@ -170,12 +197,39 @@ sub invoice_details { push(@{ $form->{discount} }, $discount); push(@{ $form->{p_discount} }, $form->{"discount_$i"}); - + if (($form->{"discount_$i"} ne "") && ($form->{"discount_$i"} != 0)) { + $form->{discount_p} = $form->{"discount_$i"}; + } $form->{total} += $linetotal; + $discount_subtotal += $linetotal; + $form->{nodiscount_total} += $nodiscount_linetotal; + $nodiscount_subtotal += $nodiscount_linetotal; + $form->{discount_total} += $form->parse_amount($myconfig, $discount); + + if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) { + $discount_subtotal = $form->format_amount($myconfig, $discount_subtotal, 2); + push(@{ $form->{discount_sub} }, $discount_subtotal); + $nodiscount_subtotal = $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push(@{ $form->{nodiscount_sub} }, $nodiscount_subtotal); + $discount_subtotal = 0; + $nodiscount_subtotal = 0; + $subtotal_header = 0; + } else { + push(@{ $form->{discount_sub} }, ""); + push(@{ $form->{nodiscount_sub} }, ""); + } + + if ($linetotal == $netto_linetotal) { + $nodiscount += $linetotal; + } push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2)); + push(@{ $form->{nodiscount_linetotal} }, + $form->format_amount($myconfig, $nodiscount_linetotal, 2)); + + @taxaccounts = split / /, $form->{"taxaccounts_$i"}; $taxrate = 0; $taxdiff = 0; @@ -247,20 +301,19 @@ sub invoice_details { while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { if ($form->{groupitems} && $ref->{partsgroup} ne $sameitem) { map { push(@{ $form->{$_} }, "") } - qw(runningnumber number serialnumber unit qty bin sellprice listprice netprice discount linetotal); + qw(runningnumber number serialnumber unit qty bin sellprice listprice netprice discount linetotal nodiscount_linetotal); $sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--"; push(@{ $form->{description} }, $sameitem); } map { $form->{"a_$_"} = $ref->{$_} } qw(partnumber description); - $form->format_string("a_partnumber", "a_description"); push(@{ $form->{description} }, $form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"} ) . qq| -- $form->{"a_partnumber"}, $form->{"a_description"}|); map { push(@{ $form->{$_} }, "") } - qw(number unit qty runningnumber serialnumber bin sellprice listprice netprice discount linetotal); + qw(number unit qty runningnumber serialnumber bin sellprice listprice netprice discount linetotal nodiscount_linetotal); } $sth->finish; @@ -269,18 +322,16 @@ sub invoice_details { } foreach my $item (sort keys %taxaccounts) { - if ($form->round_amount($taxaccounts{$item}, 2) != 0) { - push(@{ $form->{taxbase} }, - $form->format_amount($myconfig, $taxbase{$item}, 2)); + push(@{ $form->{taxbase} }, + $form->format_amount($myconfig, $taxbase{$item}, 2)); - $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); + $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); - push(@{ $form->{tax} }, $form->format_amount($myconfig, $taxamount, 2)); - push(@{ $form->{taxdescription} }, $form->{"${item}_description"}); - push(@{ $form->{taxrate} }, - $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); - push(@{ $form->{taxnumber} }, $form->{"${item}_taxnumber"}); - } + push(@{ $form->{tax} }, $form->format_amount($myconfig, $taxamount, 2)); + push(@{ $form->{taxdescription} }, $form->{"${item}_description"}); + push(@{ $form->{taxrate} }, + $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); + push(@{ $form->{taxnumber} }, $form->{"${item}_taxnumber"}); } for my $i (1 .. $form->{paidaccounts}) { @@ -296,17 +347,20 @@ sub invoice_details { } $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); + $yesdiscount = $form->{nodiscount_total} - $nodiscount; + $form->{nodiscount_subtotal} = $form->format_amount($myconfig, $form->{nodiscount_total}, 2); + $form->{discount_total} = $form->format_amount($myconfig, $form->{discount_total}, 2); + $form->{nodiscount} = $form->format_amount($myconfig, $nodiscount, 2); + $form->{yesdiscount} = $form->format_amount($myconfig, $yesdiscount, 2); + $form->{invtotal} = ($form->{taxincluded}) ? $form->{total} : $form->{total} + $tax; $form->{total} = $form->format_amount($myconfig, $form->{invtotal} - $form->{paid}, 2); $form->{invtotal} = $form->format_amount($myconfig, $form->{invtotal}, 2); - + $form->set_payment_options($myconfig, $form->{invdate}); $form->{paid} = $form->format_amount($myconfig, $form->{paid}, 2); - # myconfig variables - map { $form->{$_} = $myconfig->{$_} } - (qw(company address tel fax signature businessnumber)); $form->{username} = $myconfig->{name}; $dbh->disconnect; @@ -343,7 +397,7 @@ sub customer_details { my $dbh = $form->dbconnect($myconfig); # get contact id, set it if nessessary - ($null, $form->{cp_id}) = split /--/, $form->{contact}; + $form->{cp_id} *= 1; $contact = ""; if ($form->{cp_id}) { @@ -363,8 +417,33 @@ sub customer_details { # remove id and taxincluded before copy back delete @$ref{qw(id taxincluded)}; map { $form->{$_} = $ref->{$_} } keys %$ref; - $sth->finish; + + if ($form->{delivery_customer_id}) { + my $query = qq|SELECT ct.*, ct.notes as customernotes + FROM customer ct + WHERE ct.id = $form->{delivery_customer_id} limit 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + $sth->finish; + map { $form->{"dc_$_"} = $ref->{$_} } keys %$ref; + } + + if ($form->{delivery_vendor_id}) { + my $query = qq|SELECT ct.*, ct.notes as customernotes + FROM customer ct + WHERE ct.id = $form->{delivery_vendor_id} limit 1|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + $sth->finish; + map { $form->{"dv_$_"} = $ref->{$_} } keys %$ref; + } $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -386,12 +465,25 @@ sub post_invoice { $form->get_employee($dbh); } - ($null, $form->{contact_id}) = split /--/, $form->{contact}; + $form->{contact_id} = $form->{cp_id}; $form->{contact_id} *= 1; + $form->{payment_id} *= 1; + $form->{language_id} *= 1; + $form->{taxzone_id} *= 1; + $form->{delivery_customer_id} *= 1; + $form->{delivery_vendor_id} *= 1; + $form->{storno} *= 1; + $form->{shipto_id} *= 1; + ($null, $form->{department_id}) = split(/--/, $form->{department}); $form->{department_id} *= 1; + my $service_units = AM->retrieve_units($myconfig,$form,"service"); + my $part_units = AM->retrieve_units($myconfig,$form,"dimension"); + + + if ($form->{id}) { &reverse_invoice($dbh, $form); @@ -438,10 +530,47 @@ sub post_invoice { $form->{expense_inventory} = ""; foreach my $i (1 .. $form->{rowcount}) { - $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + if ($form->{type} eq "credit_note") { + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}) * -1; + $form->{shipped} = 1; + } else { + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + } + my $basefactor; + my $basqty; + + if ($form->{storno}) { + $form->{"qty_$i"} *= -1; + } if ($form->{"qty_$i"} != 0) { + # get item baseunit + $query = qq|SELECT p.unit + FROM parts p + WHERE p.id = $form->{"id_$i"}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($item_unit) = $sth->fetchrow_array(); + $sth->finish; + + if ($form->{"inventory_accno_$i"}) { + if (defined($part_units->{$item_unit}->{factor}) && $part_units->{$item_unit}->{factor} ne '' && $part_units->{$item_unit}->{factor} ne '0') { + $basefactor = $part_units->{$form->{"unit_$i"}}->{factor} / $part_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } else { + if (defined($service_units->{$item_unit}->{factor}) && $service_units->{$item_unit}->{factor} ne '' && $service_units->{$item_unit}->{factor} ne '0') { + $basefactor = $service_units->{$form->{"unit_$i"}}->{factor} / $service_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } + map { $form->{"${_}_$i"} =~ s/\'/\'\'/g } (qw(partnumber description unit)); @@ -530,20 +659,20 @@ sub post_invoice { if ($sth->fetchrow_array) { $form->update_balance($dbh, "parts", "onhand", qq|id = $form->{"id_$i"}|, - $form->{"qty_$i"} * -1) + $baseqty * -1) unless $form->{shipped}; } $sth->finish; # record assembly item as allocated - &process_assembly($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}); + &process_assembly($dbh, $form, $form->{"id_$i"}, $baseqty); } else { $form->update_balance($dbh, "parts", "onhand", qq|id = $form->{"id_$i"}|, - $form->{"qty_$i"} * -1) + $baseqty * -1) unless $form->{shipped}; - $allocated = &cogs($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}); + $allocated = &cogs($dbh, $form, $form->{"id_$i"}, $baseqty, $basefactor); } } @@ -556,22 +685,23 @@ sub post_invoice { ? qq|'$form->{"deliverydate_$i"}'| : "NULL"; - # get pricegroup_id and save ist - ($null, my $pricegroup_id) = split /--/, $form->{"sellprice_drag_$i"}; + # get pricegroup_id and save it + ($null, my $pricegroup_id) = split /--/, $form->{"sellprice_pg_$i"}; $pricegroup_id *= 1; + my $subtotal = $form->{"subtotal_$i"} * 1; # save detail record in invoice table - $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty, + $query = qq|INSERT INTO invoice (trans_id, parts_id, description,longdescription, qty, sellprice, fxsellprice, discount, allocated, assemblyitem, unit, deliverydate, project_id, serialnumber, pricegroup_id, - ordnumber, transdate, cusordnumber) + ordnumber, transdate, cusordnumber, base_qty, subtotal) VALUES ($form->{id}, $form->{"id_$i"}, - '$form->{"description_$i"}', $form->{"qty_$i"}, + '$form->{"description_$i"}', '$form->{"longdescription_$i"}', $form->{"qty_$i"}, $form->{"sellprice_$i"}, $fxsellprice, $form->{"discount_$i"}, $allocated, 'f', '$form->{"unit_$i"}', $deliverydate, (SELECT id from project where projectnumber = '$project_id'), '$form->{"serialnumber_$i"}', '$pricegroup_id', - '$form->{"ordnumber_$i"}', '$form->{"transdate_$i"}', '$form->{"cusordnumber_$i"}')|; + '$form->{"ordnumber_$i"}', '$form->{"transdate_$i"}', '$form->{"cusordnumber_$i"}', $baseqty, '$subtotal')|; $dbh->do($query) || $form->dberror($query); if ($form->{lizenzen}) { @@ -597,7 +727,11 @@ sub post_invoice { # total payments, don't move we need it here for my $i (1 .. $form->{paidaccounts}) { - $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + if ($form->{type} eq "credit_note") { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}) * -1; + } else { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + } $form->{paid} += $form->{"paid_$i"}; $form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"}); } @@ -707,77 +841,79 @@ sub post_invoice { # $form->{amount}{$form->{id}}{$form->{AR}} = 1 if ($form->{amount}{$form->{id}}{$form->{AR}} == 0); # record payments and offsetting AR - for my $i (1 .. $form->{paidaccounts}) { - - if ($form->{"paid_$i"} != 0) { - my ($accno) = split /--/, $form->{"AR_paid_$i"}; - $form->{"datepaid_$i"} = $form->{invdate} - unless ($form->{"datepaid_$i"}); - $form->{datepaid} = $form->{"datepaid_$i"}; - - $exchangerate = 0; - - if ($form->{currency} eq $form->{defaultcurrency}) { - $form->{"exchangerate_$i"} = 1; - } else { - $exchangerate = - $form->check_exchangerate($myconfig, $form->{currency}, - $form->{"datepaid_$i"}, 'buy'); - - $form->{"exchangerate_$i"} = - ($exchangerate) - ? $exchangerate - : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); - } - - # record AR - $amount = - $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} + $diff, - 2); - - if ($form->{amount}{ $form->{id} }{ $form->{AR} } != 0) { - $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, - transdate) - VALUES ($form->{id}, (SELECT c.id FROM chart c - WHERE c.accno = '$form->{AR}'), - $amount, '$form->{"datepaid_$i"}')|; + if (!$form->{storno}) { + for my $i (1 .. $form->{paidaccounts}) { + + if ($form->{"paid_$i"} != 0) { + my ($accno) = split /--/, $form->{"AR_paid_$i"}; + $form->{"datepaid_$i"} = $form->{invdate} + unless ($form->{"datepaid_$i"}); + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = + $form->check_exchangerate($myconfig, $form->{currency}, + $form->{"datepaid_$i"}, 'buy'); + + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + # record AR + $amount = + $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} + $diff, + 2); + + if ($form->{amount}{ $form->{id} }{ $form->{AR} } != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$form->{AR}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + + # record payment + $form->{"paid_$i"} *= -1; + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, memo) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$accno'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', + '$form->{"source_$i"}', '$form->{"memo_$i"}')|; $dbh->do($query) || $form->dberror($query); - } - - # record payment - $form->{"paid_$i"} *= -1; - - $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, - source, memo) - VALUES ($form->{id}, (SELECT c.id FROM chart c - WHERE c.accno = '$accno'), - $form->{"paid_$i"}, '$form->{"datepaid_$i"}', - '$form->{"source_$i"}', '$form->{"memo_$i"}')|; - $dbh->do($query) || $form->dberror($query); - - # exchangerate difference - $form->{fx}{$accno}{ $form->{"datepaid_$i"} } += - $form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) + $diff; - - # gain/loss - $amount = - $form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} * - $form->{"exchangerate_$i"}; - if ($amount > 0) { - $form->{fx}{ $form->{fxgain_accno} }{ $form->{"datepaid_$i"} } += - $amount; - } else { - $form->{fx}{ $form->{fxloss_accno} }{ $form->{"datepaid_$i"} } += - $amount; - } - - $diff = 0; - - # update exchange rate - if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { - $form->update_exchangerate($dbh, $form->{currency}, - $form->{"datepaid_$i"}, - $form->{"exchangerate_$i"}, 0); + + # exchangerate difference + $form->{fx}{$accno}{ $form->{"datepaid_$i"} } += + $form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) + $diff; + + # gain/loss + $amount = + $form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} * + $form->{"exchangerate_$i"}; + if ($amount > 0) { + $form->{fx}{ $form->{fxgain_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } else { + $form->{fx}{ $form->{fxloss_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } + + $diff = 0; + + # update exchange rate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, + $form->{"datepaid_$i"}, + $form->{"exchangerate_$i"}, 0); + } } } } @@ -853,18 +989,41 @@ Message: $form->{message}\r| if $form->{message}; taxincluded = '$form->{taxincluded}', curr = '$form->{currency}', department_id = $form->{department_id}, + payment_id = $form->{payment_id}, + type = '$form->{type}', + language_id = $form->{language_id}, + taxzone_id = $form->{taxzone_id}, + shipto_id = $form->{shipto_id}, + delivery_customer_id = $form->{delivery_customer_id}, + delivery_vendor_id = $form->{delivery_vendor_id}, employee_id = $form->{employee_id}, + storno = '$form->{storno}', cp_id = $form->{contact_id} WHERE id = $form->{id} |; $dbh->do($query) || $form->dberror($query); + if ($form->{storno}) { + $query = qq| update ar set paid=paid+amount where id=$form->{storno_id}|; + $dbh->do($query) || $form->dberror($query); + $query = qq| update ar set storno='$form->{storno}' where id=$form->{storno_id}|; + $dbh->do($query) || $form->dberror($query); + $query = qq§ update ar set intnotes='Rechnung storniert am $form->{invdate} ' || intnotes where id=$form->{storno_id}§; + $dbh->do($query) || $form->dberror($query); + + $query = qq| update ar set paid=amount where id=$form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + $form->{pago_total} = $amount; # add shipto $form->{name} = $form->{customer}; $form->{name} =~ s/--$form->{customer_id}//; - $form->add_shipto($dbh, $form->{id}); + + if (!$form->{shipto_id}) { + $form->add_shipto($dbh, $form->{id}, "AR"); + } # save printed, emailed and queued $form->save_status($dbh); @@ -881,6 +1040,150 @@ Message: $form->{message}\r| if $form->{message}; return $rc; } +sub post_payment { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig, $form, $locale) = @_; + + # connect to database, turn off autocommit + my $dbh = $form->dbconnect_noauto($myconfig); + + $form->{datepaid} = $form->{invdate}; + + # total payments, don't move we need it here + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{type} eq "credit_note") { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}) * -1; + } else { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + } + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"}); + } + + $form->{exchangerate} = + $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, + "buy"); + + # record payments and offsetting AR + for my $i (1 .. $form->{paidaccounts}) { + + if ($form->{"paid_$i"} != 0) { + my ($accno) = split /--/, $form->{"AR_paid_$i"}; + $form->{"datepaid_$i"} = $form->{invdate} + unless ($form->{"datepaid_$i"}); + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + if (($form->{currency} eq $form->{defaultcurrency}) || ($form->{defaultcurrency} eq "")) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = + $form->check_exchangerate($myconfig, $form->{currency}, + $form->{"datepaid_$i"}, 'buy'); + + $form->{"exchangerate_$i"} = + ($exchangerate) + ? $exchangerate + : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + # record AR + $amount = + $form->round_amount($form->{"paid_$i"} * $form->{"exchangerate"}, + 2); + + + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$form->{AR}') AND amount=$amount AND transdate='$form->{"datepaid_$i"}'|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$form->{AR}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + + + # record payment + $form->{"paid_$i"} *= -1; + + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$accno') AND amount=$form->{"paid_$i"} AND transdate='$form->{"datepaid_$i"}' AND source='$form->{"source_$i"}' AND memo='$form->{"memo_$i"}'|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, memo) + VALUES ($form->{id}, (SELECT c.id FROM chart c + WHERE c.accno = '$accno'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', + '$form->{"source_$i"}', '$form->{"memo_$i"}')|; + $dbh->do($query) || $form->dberror($query); + + + # gain/loss + $amount = + $form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} * + $form->{"exchangerate_$i"}; + if ($amount > 0) { + $form->{fx}{ $form->{fxgain_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } else { + $form->{fx}{ $form->{fxloss_accno} }{ $form->{"datepaid_$i"} } += + $amount; + } + + $diff = 0; + + # update exchange rate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, + $form->{"datepaid_$i"}, + $form->{"exchangerate_$i"}, 0); + } + } + } + + # record exchange rate differences and gains/losses + foreach my $accno (keys %{ $form->{fx} }) { + foreach my $transdate (keys %{ $form->{fx}{$accno} }) { + if ( + ($form->{fx}{$accno}{$transdate} = + $form->round_amount($form->{fx}{$accno}{$transdate}, 2) + ) != 0 + ) { + $query = qq|DELETE FROM acc_trans WHERE trans_id=$form->{id} AND chart_id=(SELECT c.id FROM chart c + WHERE c.accno = '$accno') AND amount=$form->{fx}{$accno}{$transdate} AND transdate='$transdate' AND cleared='0' AND fx_transaction='1'|; + $dbh->do($query) || $form->dberror($query); + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, cleared, fx_transaction) + VALUES ($form->{id}, + (SELECT c.id FROM chart c + WHERE c.accno = '$accno'), + $form->{fx}{$accno}{$transdate}, '$transdate', '0', '1')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL"; + + # save AR record + my $query = qq|UPDATE ar set + paid = $form->{paid}, + datepaid = $datepaid + WHERE id=$form->{id}|; + + $dbh->do($query) || $form->dberror($query); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $main::lxdebug->leave_sub(); + + return $rc; +} + sub process_assembly { $main::lxdebug->enter_sub(); @@ -936,9 +1239,9 @@ sub process_assembly { sub cogs { $main::lxdebug->enter_sub(); - my ($dbh, $form, $id, $totalqty) = @_; + my ($dbh, $form, $id, $totalqty, $basefactor) = @_; - my $query = qq|SELECT i.id, i.trans_id, i.qty, i.allocated, i.sellprice, + my $query = qq|SELECT i.id, i.trans_id, i.base_qty, i.allocated, i.sellprice, (SELECT c.accno FROM chart c WHERE p.inventory_accno_id = c.id) AS inventory_accno, (SELECT c.accno FROM chart c @@ -946,7 +1249,7 @@ sub cogs { FROM invoice i, parts p WHERE i.parts_id = p.id AND i.parts_id = $id - AND (i.qty + i.allocated) < 0 + AND (i.base_qty + i.allocated) < 0 ORDER BY trans_id|; my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -955,7 +1258,7 @@ sub cogs { my $qty; while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { - if (($qty = (($ref->{qty} * -1) - $ref->{allocated})) > $totalqty) { + if (($qty = (($ref->{base_qty} * -1) - $ref->{allocated})) > $totalqty) { $qty = $totalqty; } @@ -964,7 +1267,7 @@ sub cogs { # total expenses and inventory # sellprice is the cost of the item - $linetotal = $form->round_amount($ref->{sellprice} * $qty, 2); + $linetotal = $form->round_amount(($ref->{sellprice} * $qty) / $basefactor, 2); if (!$eur) { @@ -1065,7 +1368,7 @@ sub reverse_invoice { } $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; + WHERE trans_id = $form->{id} AND module = 'AR'|; $dbh->do($query) || $form->dberror($query); $main::lxdebug->leave_sub(); @@ -1169,10 +1472,10 @@ sub retrieve_invoice { # retrieve invoice $query = qq|SELECT a.invnumber, a.ordnumber, a.quonumber, a.cusordnumber, - a.transdate AS invdate, a.deliverydate, a.paid, - a.shippingpoint, a.shipvia, a.terms, a.notes, a.intnotes, - a.duedate, a.taxincluded, a.curr AS currency, - a.employee_id, e.name AS employee + a.transdate AS invdate, a.deliverydate, a.paid, a.storno, a.gldate, + a.shippingpoint, a.shipvia, a.terms, a.notes, a.intnotes, a.taxzone_id, + a.duedate, a.taxincluded, a.curr AS currency, a.shipto_id, a.cp_id, + a.employee_id, e.name AS employee, a.payment_id, a.language_id, a.delivery_customer_id, a.delivery_vendor_id, a.type FROM ar a LEFT JOIN employee e ON (e.id = a.employee_id) WHERE a.id = $form->{id}|; @@ -1186,17 +1489,33 @@ sub retrieve_invoice { $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, "buy"); - # get shipto $query = qq|SELECT s.* FROM shipto s - WHERE s.trans_id = $form->{id}|; + WHERE s.trans_id = $form->{id} AND s.module = 'AR'|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); $ref = $sth->fetchrow_hashref(NAME_lc); + delete($ref->{id}); map { $form->{$_} = $ref->{$_} } keys %$ref; $sth->finish; + if ($form->{delivery_customer_id}) { + $query = qq|SELECT name FROM customer WHERE id=$form->{delivery_customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ($form->{delivery_customer_string}) = $sth->fetchrow_array(); + $sth->finish; + } + + if ($form->{delivery_vendor_id}) { + $query = qq|SELECT name FROM customer WHERE id=$form->{delivery_vendor_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ($form->{delivery_vendor_string}) = $sth->fetchrow_array(); + $sth->finish; + } + # get printed, emailed $query = qq|SELECT s.printed, s.emailed, s.spoolfile, s.formname FROM status s @@ -1213,56 +1532,91 @@ sub retrieve_invoice { $sth->finish; map { $form->{$_} =~ s/ +$//g } qw(printed emailed queued); + my $transdate = + $form->{deliverydate} ? $dbh->quote($form->{deliverydate}) : + $form->{invdate} ? $dbh->quote($form->{invdate}) : + "current_date"; + + if (!$form->{taxzone_id}) { + $form->{taxzone_id} = 0; + } # retrieve individual items - $query = qq|SELECT (SELECT c.accno FROM chart c - WHERE p.inventory_accno_id = c.id) - AS inventory_accno, - (SELECT c.accno FROM chart c - WHERE p.income_accno_id = c.id) - AS income_accno, - (SELECT c.accno FROM chart c - WHERE p.expense_accno_id = c.id) - AS expense_accno, - i.description, i.qty, i.fxsellprice AS sellprice, + $query = qq|SELECT + c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid, + c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid, + c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from as expense_valid, + i.description, i.longdescription, i.qty, i.fxsellprice AS sellprice, i.discount, i.parts_id AS id, i.unit, i.deliverydate, i.project_id, pr.projectnumber, i.serialnumber, - p.partnumber, p.assembly, p.bin, p.notes AS partnotes, i.id AS invoice_pos, + p.partnumber, p.assembly, p.bin, p.notes AS partnotes, p.inventory_accno_id AS part_inventory_accno_id, i.id AS invoice_pos, pg.partsgroup, i.pricegroup_id, (SELECT pricegroup FROM pricegroup WHERE id=i.pricegroup_id) as pricegroup, - i.ordnumber, i.transdate, i.cusordnumber + i.ordnumber, i.transdate, i.cusordnumber, p.formel, i.subtotal FROM invoice i JOIN parts p ON (i.parts_id = p.id) LEFT JOIN project pr ON (i.project_id = pr.id) LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) - WHERE i.trans_id = $form->{id} + LEFT JOIN chart c1 ON ((select inventory_accno_id from buchungsgruppen where id=p.buchungsgruppen_id) = c1.id) + LEFT JOIN chart c2 ON ((select income_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c2.id) + LEFT JOIN chart c3 ON ((select expense_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c3.id) + WHERE i.trans_id = $form->{id} AND NOT i.assemblyitem = '1' ORDER BY i.id|; $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + if (!$ref->{"part_inventory_accno_id"}) { + map({ delete($ref->{$_}); } qw(inventory_accno inventory_new_chart inventory_valid)); + } + delete($ref->{"part_inventory_accno_id"}); - #set expense_accno=inventory_accno if they are different => bilanz - $vendor_accno = - ($ref->{expense_accno} != $ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; + while ($ref->{inventory_new_chart} && ($ref->{inventory_valid} >=0)) { + my $query = qq| SELECT accno AS inventory_accno, new_chart_id AS inventory_new_chart, date($transdate) - valid_from AS inventory_valid FROM chart WHERE id = $ref->{inventory_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{inventory_accno}, $ref->{inventory_new_chart}, $ref->{inventory_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{income_new_chart} && ($ref->{income_valid} >=0)) { + my $query = qq| SELECT accno AS income_accno, new_chart_id AS income_new_chart, date($transdate) - valid_from AS income_valid FROM chart WHERE id = $ref->{income_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{income_accno}, $ref->{income_new_chart}, $ref->{income_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{expense_new_chart} && ($ref->{expense_valid} >=0)) { + my $query = qq| SELECT accno AS expense_accno, new_chart_id AS expense_new_chart, date($transdate) - valid_from AS expense_valid FROM chart WHERE id = $ref->{expense_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{expense_accno}, $ref->{expense_new_chart}, $ref->{expense_valid}) = $stw->fetchrow_array; + $stw->finish; + } # get tax rates and description $accno_id = - ($form->{vc} eq "customer") ? $ref->{income_accno} : $vendor_accno; - $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber - FROM chart c, tax t - WHERE c.id=t.chart_id AND t.taxkey in (SELECT taxkey_id from chart where accno = '$accno_id') - ORDER BY accno|; + ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno}; + $query = qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id in (SELECT tk.tax_id from taxkeys tk where tk.chart_id = (SELECT id from chart WHERE accno='$accno_id') AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) + ORDER BY c.accno|; $stw = $dbh->prepare($query); $stw->execute || $form->dberror($query); $ref->{taxaccounts} = ""; + my $i=0; while ($ptr = $stw->fetchrow_hashref(NAME_lc)) { # if ($customertax{$ref->{accno}}) { + if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) { + $i++; + $ptr->{accno} = $i; + } $ref->{taxaccounts} .= "$ptr->{accno} "; + if (!($form->{taxaccounts} =~ /$ptr->{accno}/)) { $form->{"$ptr->{accno}_rate"} = $ptr->{rate}; - $form->{"$ptr->{accno}_description"} = $ptr->{description}; + $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription}; $form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; $form->{taxaccounts} .= "$ptr->{accno} "; } @@ -1280,6 +1634,9 @@ sub retrieve_invoice { ""; $stg->finish(); } + if ($form->{type} eq "credit_note") { + $ref->{qty} *= -1; + } chop $ref->{taxaccounts}; push @{ $form->{invoice_details} }, $ref; @@ -1320,10 +1677,10 @@ sub get_customer { # get customer my $query = qq|SELECT c.name AS customer, c.discount, c.creditlimit, c.terms, - c.email, c.cc, c.bcc, c.language, + c.email, c.cc, c.bcc, c.language_id, c.payment_id AS customer_payment_id, c.street, c.zipcode, c.city, c.country, $duedate + c.terms AS duedate, c.notes AS intnotes, - b.discount AS tradediscount, b.description AS business, c.klass as customer_klass + b.discount AS tradediscount, b.description AS business, c.klass as customer_klass, c.taxzone_id FROM customer c LEFT JOIN business b ON (b.id = c.business_id) WHERE c.id = $form->{customer_id}|; @@ -1335,6 +1692,45 @@ sub get_customer { map { $form->{$_} = $ref->{$_} } keys %$ref; $sth->finish; + my $query = qq|SELECT sum(a.amount-a.paid) AS dunning_amount FROM ar a WHERE a.paid < a.amount AND a.customer_id=$form->{customer_id} AND a.dunning_id IS NOT NULL|; + my $sth = $dbh->prepare($query); + + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + #print(STDERR "DUNNING AMOUTN $form->{dunning_amount}\n"); + + my $query = qq|SELECT dnn.dunning_description AS max_dunning_level FROM dunning_config dnn WHERE id in (select dunning_id from ar WHERE paid < amount AND customer_id=$form->{customer_id} AND dunning_id IS NOT NULL) ORDER BY dunning_level DESC LIMIT 1|; + my $sth = $dbh->prepare($query); + + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + #print(STDERR "LEVEL $form->{max_dunning_level}\n"); + + + #check whether payment_terms are better than old payment_terms + if (($form->{payment_id} ne "") && ($form->{customer_payment_id} ne "")) { + my $query = qq|select (select ranking from payment_terms WHERE id = $form->{payment_id}), (select ranking from payment_terms WHERE id = $form->{customer_payment_id})|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($old_ranking, $new_ranking) = $stw->fetchrow_array; + $stw->finish; + if ($new_ranking > $old_ranking) { + $form->{payment_id} =$form->{customer_payment_id}; + } + } + if ($form->{payment_id} eq "") { + $form->{payment_id} =$form->{customer_payment_id}; + } + $form->{creditremaining} = $form->{creditlimit}; $query = qq|SELECT SUM(a.amount - a.paid) FROM ar a @@ -1364,10 +1760,10 @@ sub get_customer { $sth->finish; $form->get_contacts($dbh, $form->{customer_id}); - ($null, $form->{cp_id}) = split /--/, $form->{contact}; + $form->{cp_id} *= 1; # get contact if selected - if ($form->{contact} ne "--" && $form->{contact} ne "") { + if ($form->{cp_id}) { $form->get_contact($dbh, $form->{cp_id}); } @@ -1377,11 +1773,12 @@ sub get_customer { qw(shiptoname shiptodepartment_1 shiptodepartment_2 shiptostreet shiptozipcode shiptocity shiptocountry shiptocontact shiptophone shiptofax shiptoemail); $query = qq|SELECT s.* FROM shipto s - WHERE s.trans_id = $form->{customer_id}|; + WHERE s.trans_id = $form->{customer_id} AND s.module = 'CT'|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); $ref = $sth->fetchrow_hashref(NAME_lc); + undef($ref->{id}); map { $form->{$_} = $ref->{$_} } keys %$ref; $sth->finish; } @@ -1400,6 +1797,19 @@ sub get_customer { } $sth->finish; + # get shipping addresses + $query = qq|SELECT s.shipto_id,s.shiptoname,s.shiptodepartment_1 + FROM shipto s + WHERE s.trans_id = $form->{customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $customertax = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{ $form->{SHIPTO} }, $ref); + } + $sth->finish; + # setup last accounts used for this customer if (!$form->{id} && $form->{type} !~ /_(order|quotation)/) { $query = qq|SELECT c.accno, c.description, c.link, c.category @@ -1438,6 +1848,9 @@ sub retrieve_item { my ($self, $myconfig, $form) = @_; + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $i = $form->{rowcount}; my $where = "NOT p.obsolete = '1'"; @@ -1462,20 +1875,29 @@ sub retrieve_item { $where .= " ORDER BY p.partnumber"; } - # connect to database - my $dbh = $form->dbconnect($myconfig); + my $transdate; + if ($form->{type} eq "invoice") { + $transdate = + $form->{deliverydate} ? $dbh->quote($form->{deliverydate}) : + $form->{invdate} ? $dbh->quote($form->{invdate}) : + "current_date"; + } else { + $transdate = + $form->{transdate} ? $dbh->quote($form->{transdate}) : + "current_date"; + } my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, - p.listprice, - c1.accno AS inventory_accno, - c2.accno AS income_accno, - c3.accno AS expense_accno, - p.unit, p.assembly, p.bin, p.onhand, p.notes AS partnotes, - pg.partsgroup + p.listprice, p.inventory_accno_id, + c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid, + c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid, + c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from as expense_valid, + p.unit, p.assembly, p.bin, p.onhand, p.notes AS partnotes, p.notes AS longdescription, p.not_discountable, + pg.partsgroup, p.formel, p.payment_id AS part_payment_id FROM parts p - LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) - LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) - LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN chart c1 ON ((select inventory_accno_id from buchungsgruppen where id=p.buchungsgruppen_id) = c1.id) + LEFT JOIN chart c2 ON ((select income_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c2.id) + LEFT JOIN chart c3 ON ((select expense_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c3.id) LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) WHERE $where|; my $sth = $dbh->prepare($query); @@ -1483,30 +1905,77 @@ sub retrieve_item { while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + # In der Buchungsgruppe ist immer ein Bestandskonto verknuepft, auch wenn + # es sich um eine Dienstleistung handelt. Bei Dienstleistungen muss das + # Buchungskonto also aus dem Ergebnis rausgenommen werden. + if (!$ref->{inventory_accno_id}) { + map({ delete($ref->{"inventory_${_}"}); } qw(accno new_chart valid)); + } + delete($ref->{inventory_accno_id}); + #set expense_accno=inventory_accno if they are different => bilanz - $vendor_accno = - ($ref->{expense_accno} != $ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; + + + while ($ref->{inventory_new_chart} && ($ref->{inventory_valid} >=0)) { + my $query = qq| SELECT accno AS inventory_accno, new_chart_id AS inventory_new_chart, date($transdate) - valid_from AS inventory_valid FROM chart WHERE id = $ref->{inventory_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{inventory_accno}, $ref->{inventory_new_chart}, $ref->{inventory_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{income_new_chart} && ($ref->{income_valid} >=0)) { + my $query = qq| SELECT accno AS income_accno, new_chart_id AS income_new_chart, date($transdate) - valid_from AS income_valid FROM chart WHERE id = $ref->{income_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{income_accno}, $ref->{income_new_chart}, $ref->{income_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{expense_new_chart} && ($ref->{expense_valid} >=0)) { + my $query = qq| SELECT accno AS expense_accno, new_chart_id AS expense_new_chart, date($transdate) - valid_from AS expense_valid FROM chart WHERE id = $ref->{expense_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{expense_accno}, $ref->{expense_new_chart}, $ref->{expense_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + #check whether payment_terms are better than old payment_terms + if (($form->{payment_id} ne "") && ($ref->{part_payment_id} ne "")) { + my $query = qq|select (select ranking from payment_terms WHERE id = $form->{payment_id}), (select ranking from payment_terms WHERE id = $ref->{part_payment_id})|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($old_ranking, $new_ranking) = $stw->fetchrow_array; + $stw->finish; + if ($new_ranking <= $old_ranking) { + $ref->{part_payment_id} = ""; + } + } # get tax rates and description $accno_id = - ($form->{vc} eq "customer") ? $ref->{income_accno} : $vendor_accno; - $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber - FROM chart c, tax t - WHERE c.id=t.chart_id AND t.taxkey in (SELECT c2.taxkey_id from chart c2 where c2.accno = '$accno_id') + ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno}; + $query = qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id in (SELECT tk.tax_id from taxkeys tk where tk.chart_id = (SELECT id from chart WHERE accno='$accno_id') AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) ORDER BY c.accno|; $stw = $dbh->prepare($query); $stw->execute || $form->dberror($query); $ref->{taxaccounts} = ""; + my $i = 0; while ($ptr = $stw->fetchrow_hashref(NAME_lc)) { # if ($customertax{$ref->{accno}}) { + if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) { + $i++; + $ptr->{accno} = $i; + } $ref->{taxaccounts} .= "$ptr->{accno} "; + if (!($form->{taxaccounts} =~ /$ptr->{accno}/)) { $form->{"$ptr->{accno}_rate"} = $ptr->{rate}; - $form->{"$ptr->{accno}_description"} = $ptr->{description}; + $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription}; $form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; $form->{taxaccounts} .= "$ptr->{accno} "; } @@ -1515,6 +1984,32 @@ sub retrieve_item { $stw->finish; chop $ref->{taxaccounts}; + if ($form->{language_id}) { + $query = qq|SELECT tr.translation, tr.longdescription + FROM translation tr + WHERE tr.language_id=$form->{language_id} AND tr.parts_id=$ref->{id}|; + $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + my ($translation, $longdescription) = $stw->fetchrow_array(); + if ($translation ne "") { + $ref->{description} = $translation; + $ref->{longdescription} = $longdescription; + + } else { + $query = qq|SELECT tr.translation, tr.longdescription + FROM translation tr + WHERE tr.language_id in (select id from language where article_code=(select article_code from language where id = $form->{language_id})) AND tr.parts_id=$ref->{id} LIMIT 1|; + $stg = $dbh->prepare($query); + $stg->execute || $form->dberror($query); + my ($translation) = $stg->fetchrow_array(); + if ($translation ne "") { + $ref->{description} = $translation; + $ref->{longdescription} = $longdescription; + } + $stg->finish; + } + $stw->finish; + } push @{ $form->{item_list} }, $ref; @@ -1551,10 +2046,15 @@ sub get_pricegroups_for_parts { my $dbh = $form->dbconnect($myconfig); + $form->{"PRICES"} = {}; + my $i = 1; my $id = 0; - + my $dimension_units = AM->retrieve_units($myconfig, $form, "dimension"); + my $service_units = AM->retrieve_units($myconfig, $form, "service"); + my $all_units = AM->retrieve_units($myconfig, $form); while (($form->{"id_$i"}) or ($form->{"new_id_$i"})) { + $form->{"PRICES"}{$i} = []; $id = $form->{"id_$i"}; @@ -1564,23 +2064,55 @@ sub get_pricegroups_for_parts { } ($price, $selectedpricegroup_id) = split /--/, - $form->{"sellprice_drag_$i"}; + $form->{"sellprice_pg_$i"}; $pricegroup_old = $form->{"pricegroup_old_$i"}; - + $form->{"new_pricegroup_$i"} = $selectedpricegroup_id; + $form->{"old_pricegroup_$i"} = $pricegroup_old; $price_new = $form->{"price_new_$i"}; $price_old = $form->{"price_old_$i"}; - $query = qq|SELECT pricegroup_id, (SELECT p.sellprice from parts p where p.id = $id) as default_sellprice,(SELECT pg.pricegroup FROM pricegroup pg WHERE id=pricegroup_id) AS pricegroup, price, '' AS selected FROM prices WHERE parts_id = $id UNION SELECT 0 as pricegroup_id,(SELECT sellprice FROM parts WHERE id=$id) as default_sellprice,'' as pricegroup, (SELECT DISTINCT sellprice from parts where id=$id) as price, 'selected' AS selected from prices ORDER BY pricegroup|; $pkq = $dbh->prepare($query); $pkq->execute || $form->dberror($query); + if (!$form->{"unit_old_$i"}) { + # Neue Ware aus der Datenbank. In diesem Fall ist unit_$i die + # Einheit, wie sie in den Stammdaten hinterlegt wurde. + # Es sollte also angenommen werden, dass diese ausgewaehlt war. + $form->{"unit_old_$i"} = $form->{"unit_$i"}; + } + + # Die zuletzt ausgewaehlte mit der aktuell ausgewaehlten Einheit + # vergleichen und bei Unterschied den Preis entsprechend umrechnen. + $form->{"selected_unit_$i"} = $form->{"unit_$i"} unless ($form->{"selected_unit_$i"}); + + my $check_units = $form->{"inventory_accno_$i"} ? $dimension_units : $service_units; + if (!$check_units->{$form->{"selected_unit_$i"}} || + ($check_units->{$form->{"selected_unit_$i"}}->{"base_unit"} ne + $all_units->{$form->{"unit_old_$i"}}->{"base_unit"})) { + # Die ausgewaehlte Einheit ist fuer diesen Artikel nicht gueltig + # (z.B. Dimensionseinheit war ausgewaehlt, es handelt sich aber + # um eine Dienstleistung). Dann keinerlei Umrechnung vornehmen. + $form->{"unit_old_$i"} = $form->{"selected_unit_$i"} = $form->{"unit_$i"}; + } + my $basefactor = 1; + + if ($form->{"unit_old_$i"} ne $form->{"selected_unit_$i"}) { + if (defined($all_units->{$form->{"unit_old_$i"}}->{"factor"}) && + $all_units->{$form->{"unit_old_$i"}}->{"factor"}) { + $basefactor = $all_units->{$form->{"selected_unit_$i"}}->{"factor"} / + $all_units->{$form->{"unit_old_$i"}}->{"factor"}; + } + } + if (!$form->{"basefactor_$i"}) { + $form->{"basefactor_$i"} = 1; + } while ($pkr = $pkq->fetchrow_hashref(NAME_lc)) { # push @{ $form->{PRICES}{$id} }, $pkr; - push @{ $form->{PRICES}{$i} }, $pkr; + #push @{ $form->{PRICES}{$i} }, $pkr; $pkr->{id} = $id; $pkr->{selected} = ''; @@ -1589,13 +2121,17 @@ sub get_pricegroups_for_parts { $pkr->{price} /= $form->{exchangerate}; } + + $pkr->{price} *= $form->{"basefactor_$i"}; + + $pkr->{price} *= $basefactor; + $pkr->{price} = $form->format_amount($myconfig, $pkr->{price}, 5); if ($selectedpricegroup_id eq undef) { if ($pkr->{pricegroup_id} eq $form->{customer_klass}) { $pkr->{selected} = ' selected'; - $last->{selected} = ''; # no customer pricesgroup set if ($pkr->{price} == $pkr->{default_sellprice}) { @@ -1615,38 +2151,37 @@ sub get_pricegroups_for_parts { } } } + if ($selectedpricegroup_id or $selectedpricegroup_id == 0) { if ($selectedpricegroup_id ne $pricegroup_old) { if ($pkr->{pricegroup_id} eq $selectedpricegroup_id) { - if ($price_new != $form->{"sellprice_$i"}) { - } else { - $pkr->{selected} = ' selected'; - $last->{selected} = ''; - } + $pkr->{selected} = ' selected'; } } else { if (($price_new != $form->{"sellprice_$i"}) and ($price_new ne 0)) { if ($pkr->{pricegroup_id} == 0) { $pkr->{price} = $form->{"sellprice_$i"}; $pkr->{selected} = ' selected'; - $last->{selected} = ''; } } else { if ($pkr->{pricegroup_id} eq $selectedpricegroup_id) { $pkr->{selected} = ' selected'; - $last->{selected} = ''; if ( ($pkr->{pricegroup_id} == 0) and ($pkr->{price} == $form->{"sellprice_$i"})) { # $pkr->{price} = $form->{"sellprice_$i"}; - } else { + } else { $pkr->{price} = $form->{"sellprice_$i"}; } } } } } + push @{ $form->{PRICES}{$i} }, $pkr; + } + $form->{"basefactor_$i"} *= $basefactor; + $i++; $pkq->finish; diff --git a/SL/LICENSES.pm b/SL/LICENSES.pm index 25b4d66ee..ce1e799d6 100644 --- a/SL/LICENSES.pm +++ b/SL/LICENSES.pm @@ -127,7 +127,7 @@ sub search { if ($form->{"customer_name"}) { $f .= " AND " if ($f); $f .= - "(customer_id IN (SELECT id FROM customer WHERE name ILIKE " + "(l.customer_id IN (SELECT id FROM customer WHERE name ILIKE " . $dbh->quote('%' . $form->{"customer_name"} . '%') . "))"; } diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 8a9619ca4..10536c098 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -4,6 +4,7 @@ use constant NONE => 0; use constant INFO => 1; use constant DEBUG1 => 2; use constant DEBUG2 => 3; +use constant QUERY => 4; use constant FILE_TARGET => 0; use constant STDERR_TARGET => 1; @@ -52,48 +53,52 @@ sub set_target { } sub enter_sub { - my ($self) = @_; + my ($self, $level) = @_; + + return 1 if $global_trace_subs < $level; if (!$self->{"trace_subs"} && !$global_trace_subs) { - return; + return 1; } my ($package, $filename, $line, $subroutine) = caller(1); my ($dummy1, $self_filename, $self_line) = caller(0); - my $indent = " " x $self->{"calldepth"}; + my $indent = " " x $self->{"calldepth"}; $self->{"calldepth"} += 1; if (!defined($package)) { - $self->_write("enter_sub", $indent . "top-level?\n"); + $self->_write('sub', $indent . "\\ top-level?\n"); } else { - $self->_write("enter_sub", - $indent - . "${subroutine} in " + $self->_write('sub', $indent + . "\\ ${subroutine} in " . "${self_filename}:${self_line} called from " . "${filename}:${line}\n"); } + return 1; } sub leave_sub { - my ($self) = @_; + my ($self, $level) = @_; + + return 1 if $global_trace_subs < $level; if (!$self->{"trace_subs"} && !$global_trace_subs) { - return; + return 1; } my ($package, $filename, $line, $subroutine) = caller(1); my ($dummy1, $self_filename, $self_line) = caller(0); $self->{"calldepth"} -= 1; - my $indent = " " x $self->{"calldepth"}; + my $indent = " " x $self->{"calldepth"}; if (!defined($package)) { - $self->_write("leave_sub", $indent . "top-level?\n"); + $self->_write('sub', $indent . "/ top-level?\n"); } else { - $self->_write("leave_sub", - $indent . "${subroutine} in " . "${self_filename}:${self_line}\n"); + $self->_write('sub', $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n"); } + return 1; } sub message { @@ -105,10 +110,11 @@ sub message { } if ($log_level >= $level) { - $self->_write(INFO == $level - ? "info" - : DEBUG1 == $level ? "debug1" : "debug2", - $message); + $self->_write(INFO == $level ? "info" + : DEBUG1 == $level ? "debug1" + : DEBUG2 == $level ? "debug2" + : QUERY == $level ? "query":"", + $message ); } } @@ -131,7 +137,7 @@ sub enable_sub_tracing { sub disable_sub_tracing { my ($self) = @_; - $self->{"trace_subs"} = 1; + $self->{"trace_subs"} = 0; } sub _write { diff --git a/SL/Mailer.pm b/SL/Mailer.pm index 76eac68e3..453603ff1 100644 --- a/SL/Mailer.pm +++ b/SL/Mailer.pm @@ -41,18 +41,61 @@ sub new { bless $self, $type; } +sub mime_quote_text { + $main::lxdebug->enter_sub(); + + my ($self, $text, $chars_left) = @_; + + my $q_start = "=?$self->{charset}?Q?"; + my $l_start = length($q_start); + + my $new_text = "$q_start"; + $chars_left -= $l_start; + + for (my $i = 0; $i < length($text); $i++) { + my $char = ord(substr($text, $i, 1)); + + if (($char < 32) || ($char > 127) || + ($char == ord('?')) || ($char == ord('_'))) { + if ($chars_left < 5) { + $new_text .= "?=\n $q_start"; + $chars_left = 75 - $l_start; + } + + $new_text .= sprintf("=%02X", $char); + $chars_left -= 3; + + } else { + $char = ord('_') if ($char == ord(' ')); + if ($chars_left < 5) { + $new_text .= "?=\n $q_start"; + $chars_left = 75 - $l_start; + } + + $new_text .= chr($char); + $chars_left--; + } + } + + $new_text .= "?="; + + $main::lxdebug->leave_sub(); + + return $new_text; +} + sub send { $main::lxdebug->enter_sub(); my ($self, $out) = @_; my $boundary = time; - $boundary = "SL-$self->{version}-$boundary"; + $boundary = "LxOffice-$self->{version}-$boundary"; my $domain = $self->{from}; $domain =~ s/(.*?\@|>)//g; my $msgid = "$boundary\@$domain"; - $self->{charset} = "ISO-8859-1" unless $self->{charset}; + $self->{charset} = "ISO-8859-15" unless $self->{charset}; if ($out) { if (!open(OUT, $out)) { @@ -79,11 +122,13 @@ sub send { $self->{$item} =~ s/\$>\$/>/g; } + my $subject = $self->mime_quote_text($self->{subject}, 60); + print OUT qq|From: $self->{from} To: $self->{to} -${cc}${bcc}Subject: $self->{subject} +${cc}${bcc}Subject: $subject Message-ID: <$msgid> -X-Mailer: SQL-Ledger $self->{version} +X-Mailer: Lx-Office $self->{version} MIME-Version: 1.0 |; diff --git a/SL/Menu.pm b/SL/Menu.pm index 0bdf945e4..5da42e64a 100644 --- a/SL/Menu.pm +++ b/SL/Menu.pm @@ -69,7 +69,7 @@ sub menuitem { my $level = $form->escape($item); my $str = - qq|{path}&action=$action&level=$level&login=$form->{login}&password=$form->{password}|; + qq|{path}&action=$action&level=$level&login=$form->{login}&password=$form->{password}|; my @vars = qw(module action target href); @@ -138,7 +138,7 @@ sub menuitemNew { } sub access_control { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $menulevel) = @_; @@ -161,10 +161,23 @@ sub access_control { @a = (); map { push @a, $_ unless $excl{$_} } (@menu); - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return @a; } +sub generate_acl { + my ($self, $menulevel, $hash) = @_; + + my @items = $self->access_control(\%main::myconfig, $menulevel); + + $menulevel =~ s/[^A-Za-z_\/\.\+\-]/_/g; + $hash->{"access_" . lc($menulevel)} = 1 if ($menulevel); + + foreach my $item (@items) { + $self->generate_acl($item, $hash); #unless ($menulevel); + } +} + 1; diff --git a/SL/OE.pm b/SL/OE.pm index fb7153c4f..c5e36654d 100644 --- a/SL/OE.pm +++ b/SL/OE.pm @@ -34,6 +34,8 @@ package OE; +use SL::AM; + sub transactions { $main::lxdebug->enter_sub(); @@ -161,13 +163,23 @@ sub save { my ($query, $sth, $null); my $exchangerate = 0; + my $service_units = AM->retrieve_units($myconfig,$form,"service"); + my $part_units = AM->retrieve_units($myconfig,$form,"dimension"); + $form->{service_units} =$service_units; + $form->{part_units} =$part_units; + ($null, $form->{employee_id}) = split /--/, $form->{employee}; unless ($form->{employee_id}) { $form->get_employee($dbh); } - ($null, $form->{contact_id}) = split /--/, $form->{contact}; + $form->{contact_id} = $form->{cp_id}; $form->{contact_id} *= 1; + $form->{payment_id} *= 1; + $form->{language_id} *= 1; + $form->{shipto_id} *= 1; + $form->{delivery_customer_id} *= 1; + $form->{delivery_vendor_id} *= 1; my $ml = ($form->{type} eq 'sales_order') ? 1 : -1; @@ -180,7 +192,7 @@ sub save { $dbh->do($query) || $form->dberror($query); $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; + WHERE trans_id = $form->{id} AND module = 'OE'|; $dbh->do($query) || $form->dberror($query); } else { @@ -229,6 +241,32 @@ sub save { if ($form->{"qty_$i"}) { + # get item baseunit + $query = qq|SELECT p.unit + FROM parts p + WHERE p.id = $form->{"id_$i"}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($item_unit) = $sth->fetchrow_array(); + $sth->finish; + + if ($form->{"inventory_accno_$i"}) { + if (defined($part_units->{$item_unit}->{factor}) && $part_units->{$item_unit}->{factor} ne '' && $part_units->{$item_unit}->{factor} ne '0') { + $basefactor = $part_units->{$form->{"unit_$i"}}->{factor} / $part_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } else { + if (defined($service_units->{$item_unit}->{factor}) && $service_units->{$item_unit}->{factor} ne '' && $service_units->{$item_unit}->{factor} ne '0') { + $basefactor = $service_units->{$form->{"unit_$i"}}->{factor} / $service_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $form->{"qty_$i"} * $basefactor; + } + map { $form->{"${_}_$i"} =~ s/\'/\'\'/g } qw(partnumber description unit); @@ -313,24 +351,25 @@ sub save { ($form->{"reqdate_$i"}) ? qq|'$form->{"reqdate_$i"}'| : "NULL"; # get pricegroup_id and save ist - ($null, my $pricegroup_id) = split /--/, $form->{"sellprice_drag_$i"}; + ($null, my $pricegroup_id) = split /--/, $form->{"sellprice_pg_$i"}; $pricegroup_id *= 1; + $subtotal = $form->{"subtotal_$i"} * 1; # save detail record in orderitems table $query = qq|INSERT INTO orderitems (|; $query .= "id, " if $form->{"orderitems_id_$i"}; - $query .= qq|trans_id, parts_id, description, qty, sellprice, discount, + $query .= qq|trans_id, parts_id, description, longdescription, qty, base_qty, sellprice, discount, unit, reqdate, project_id, serialnumber, ship, pricegroup_id, - ordnumber, transdate, cusordnumber) + ordnumber, transdate, cusordnumber, subtotal) VALUES (|; $query .= qq|$form->{"orderitems_id_$i"},| if $form->{"orderitems_id_$i"}; $query .= qq|$form->{id}, $form->{"id_$i"}, - '$form->{"description_$i"}', $form->{"qty_$i"}, + '$form->{"description_$i"}', '$form->{"longdescription_$i"}', $form->{"qty_$i"}, $baseqty, $fxsellprice, $form->{"discount_$i"}, '$form->{"unit_$i"}', $reqdate, (SELECT id from project where projectnumber = '$project_id'), '$form->{"serialnumber_$i"}', $form->{"ship_$i"}, '$pricegroup_id', - '$form->{"ordnumber_$i"}', '$form->{"transdate_$i"}', '$form->{"cusordnumber_$i"}')|; + '$form->{"ordnumber_$i"}', '$form->{"transdate_$i"}', '$form->{"cusordnumber_$i"}', '$subtotal')|; $dbh->do($query) || $form->dberror($query); $form->{"sellprice_$i"} = $fxsellprice; @@ -395,6 +434,12 @@ Message: $form->{message}\r| if $form->{message}; ($null, $form->{department_id}) = split(/--/, $form->{department}); $form->{department_id} *= 1; + $form->{payment_id} *= 1; + $form->{language_id} *= 1; + $form->{taxzone_id} *= 1; + $form->{proforma} *= 1; + + # save OE record $query = qq|UPDATE oe set @@ -414,8 +459,15 @@ Message: $form->{message}\r| if $form->{message}; intnotes = '$form->{intnotes}', curr = '$form->{currency}', closed = '$form->{closed}', + proforma = '$form->{proforma}', quotation = '$quotation', department_id = $form->{department_id}, + language_id = $form->{language_id}, + taxzone_id = $form->{taxzone_id}, + shipto_id = $form->{shipto_id}, + payment_id = $form->{payment_id}, + delivery_vendor_id = $form->{delivery_vendor_id}, + delivery_customer_id = $form->{delivery_customer_id}, employee_id = $form->{employee_id}, cp_id = $form->{contact_id} WHERE id = $form->{id}|; @@ -430,7 +482,10 @@ Message: $form->{message}\r| if $form->{message}; # add shipto $form->{name} = $form->{ $form->{vc} }; $form->{name} =~ s/--$form->{"$form->{vc}_id"}//; - $form->add_shipto($dbh, $form->{id}); + + if (!$form->{shipto_id}) { + $form->add_shipto($dbh, $form->{id}, "OE"); + } # save printed, emailed, queued $form->save_status($dbh); @@ -558,7 +613,7 @@ sub delete { $dbh->do($query) || $form->dberror($query); $query = qq|DELETE FROM shipto - WHERE trans_id = $form->{id}|; + WHERE trans_id = $form->{id} AND module = 'OE'|; $dbh->do($query) || $form->dberror($query); my $rc = $dbh->commit; @@ -653,7 +708,7 @@ sub retrieve { o.curr AS currency, e.name AS employee, o.employee_id, o.$form->{vc}_id, cv.name AS $form->{vc}, o.amount AS invtotal, o.closed, o.reqdate, o.quonumber, o.department_id, o.cusordnumber, - d.description AS department + d.description AS department, o.payment_id, o.language_id, o.taxzone_id, o.delivery_customer_id, o.delivery_vendor_id, o.proforma, o.shipto_id FROM oe o JOIN $form->{vc} cv ON (o.$form->{vc}_id = cv.id) LEFT JOIN employee e ON (o.employee_id = e.id) @@ -671,6 +726,8 @@ sub retrieve { $ref = $sth->fetchrow_hashref(NAME_lc); map { $form->{$_} = $ref->{$_} } keys %$ref; + + # set all entries for multiple ids blank that yield different information while ($ref = $sth->fetchrow_hashref(NAME_lc)) { map { $form->{$_} = '' if ($ref->{$_} ne $form->{$_}) } keys %$ref; @@ -682,14 +739,31 @@ sub retrieve { $sth->finish; + if ($form->{delivery_customer_id}) { + $query = qq|SELECT name FROM customer WHERE id=$form->{delivery_customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ($form->{delivery_customer_string}) = $sth->fetchrow_array(); + $sth->finish; + } + + if ($form->{delivery_vendor_id}) { + $query = qq|SELECT name FROM customer WHERE id=$form->{delivery_vendor_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + ($form->{delivery_vendor_string}) = $sth->fetchrow_array(); + $sth->finish; + } + # shipto and pinted/mailed/queued status makes only sense for single id retrieve if (!@ids) { $query = qq|SELECT s.* FROM shipto s - WHERE s.trans_id = $form->{id}|; + WHERE s.trans_id = $form->{id} AND s.module = 'OE'|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); $ref = $sth->fetchrow_hashref(NAME_lc); + delete($ref->{id}); map { $form->{$_} = $ref->{$_} } keys %$ref; $sth->finish; @@ -713,26 +787,32 @@ sub retrieve { my %oid = ('Pg' => 'oid', 'Oracle' => 'rowid'); + my $transdate = + $form->{transdate} ? $dbh->quote($form->{transdate}) : "current_date"; + + if(!$form->{taxzone_id}) { + $form->{taxzone_id} = 0; + } # retrieve individual items # this query looks up all information about the items # stuff different from the whole will not be overwritten, but saved with a suffix. $query = qq|SELECT o.id AS orderitems_id, - c1.accno AS inventory_accno, - c2.accno AS income_accno, - c3.accno AS expense_accno, + c1.accno AS inventory_accno, c1.new_chart_id AS inventory_new_chart, date($transdate) - c1.valid_from as inventory_valid, + c2.accno AS income_accno, c2.new_chart_id AS income_new_chart, date($transdate) - c2.valid_from as income_valid, + c3.accno AS expense_accno, c3.new_chart_id AS expense_new_chart, date($transdate) - c3.valid_from as expense_valid, oe.ordnumber AS ordnumber_oe, oe.transdate AS transdate_oe, oe.cusordnumber AS cusordnumber_oe, p.partnumber, p.assembly, o.description, o.qty, - o.sellprice, o.parts_id AS id, o.unit, o.discount, p.bin, p.notes AS partnotes, + o.sellprice, o.parts_id AS id, o.unit, o.discount, p.bin, p.notes AS partnotes, p.inventory_accno_id AS part_inventory_accno_id, o.reqdate, o.project_id, o.serialnumber, o.ship, - o.ordnumber, o.transdate, o.cusordnumber, - pr.projectnumber, + o.ordnumber, o.transdate, o.cusordnumber, o.subtotal, o.longdescription, + pr.projectnumber, p.formel, pg.partsgroup, o.pricegroup_id, (SELECT pricegroup FROM pricegroup WHERE id=o.pricegroup_id) as pricegroup FROM orderitems o JOIN parts p ON (o.parts_id = p.id) JOIN oe ON (o.trans_id = oe.id) - LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) - LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) - LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN chart c1 ON ((select inventory_accno_id from buchungsgruppen where id=p.buchungsgruppen_id) = c1.id) + LEFT JOIN chart c2 ON ((select income_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c2.id) + LEFT JOIN chart c3 ON ((select expense_accno_id_$form->{taxzone_id} from buchungsgruppen where id=p.buchungsgruppen_id) = c3.id) LEFT JOIN project pr ON (o.project_id = pr.id) LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) | @@ -746,6 +826,10 @@ sub retrieve { $sth->execute || $form->dberror($query); while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if (!$ref->{"part_inventory_accno_id"}) { + map({ delete($ref->{$_}); } qw(inventory_accno inventory_new_chart inventory_valid)); + } + delete($ref->{"part_inventory_accno_id"}); # in collective order, copy global ordnumber, transdate, cusordnumber into item scope # unless already present there @@ -755,29 +839,57 @@ sub retrieve { if (@ids); map { delete $ref->{$_} } qw|ordnumber_oe transdate_oe cusordnumber_oe|; - #set expense_accno=inventory_accno if they are different => bilanz - $vendor_accno = - ($ref->{expense_accno} != $ref->{inventory_accno}) - ? $ref->{inventory_accno} - : $ref->{expense_accno}; + + + while ($ref->{inventory_new_chart} && ($ref->{inventory_valid} >=0)) { + my $query = qq| SELECT accno AS inventory_accno, new_chart_id AS inventory_new_chart, date($transdate) - valid_from AS inventory_valid FROM chart WHERE id = $ref->{inventory_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{inventory_accno}, $ref->{inventory_new_chart}, $ref->{inventory_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{income_new_chart} && ($ref->{income_valid} >=0)) { + my $query = qq| SELECT accno AS income_accno, new_chart_id AS income_new_chart, date($transdate) - valid_from AS income_valid FROM chart WHERE id = $ref->{income_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{income_accno}, $ref->{income_new_chart}, $ref->{income_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + while ($ref->{expense_new_chart} && ($ref->{expense_valid} >=0)) { + my $query = qq| SELECT accno AS expense_accno, new_chart_id AS expense_new_chart, date($transdate) - valid_from AS expense_valid FROM chart WHERE id = $ref->{expense_new_chart}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + ($ref->{expense_accno}, $ref->{expense_new_chart}, $ref->{expense_valid}) = $stw->fetchrow_array; + $stw->finish; + } + + # delete orderitems_id in collective orders, so that they get cloned no matter what + delete $ref->{orderitems_id} if (@ids); # get tax rates and description $accno_id = - ($form->{vc} eq "customer") ? $ref->{income_accno} : $vendor_accno; - $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber - FROM chart c, tax t - WHERE c.id=t.chart_id AND t.taxkey in (SELECT taxkey_id from chart where accno = '$accno_id') - ORDER BY accno|; + ($form->{vc} eq "customer") ? $ref->{income_accno} : $ref->{expense_accno}; + $query = qq|SELECT c.accno, t.taxdescription, t.rate, t.taxnumber + FROM tax t LEFT JOIN chart c on (c.id=t.chart_id) + WHERE t.id in (SELECT tk.tax_id from taxkeys tk where tk.chart_id = (SELECT id from chart WHERE accno='$accno_id') AND startdate<=$transdate ORDER BY startdate desc LIMIT 1) + ORDER BY c.accno|; $stw = $dbh->prepare($query); $stw->execute || $form->dberror($query); $ref->{taxaccounts} = ""; + my $i = 0; while ($ptr = $stw->fetchrow_hashref(NAME_lc)) { # if ($customertax{$ref->{accno}}) { + if (($ptr->{accno} eq "") && ($ptr->{rate} == 0)) { + $i++; + $ptr->{accno} = $i; + } $ref->{taxaccounts} .= "$ptr->{accno} "; if (!($form->{taxaccounts} =~ /$ptr->{accno}/)) { $form->{"$ptr->{accno}_rate"} = $ptr->{rate}; - $form->{"$ptr->{accno}_description"} = $ptr->{description}; + $form->{"$ptr->{accno}_description"} = $ptr->{taxdescription}; $form->{"$ptr->{accno}_taxnumber"} = $ptr->{taxnumber}; $form->{taxaccounts} .= "$ptr->{accno} "; } @@ -806,6 +918,19 @@ sub retrieve { &webdav_folder($myconfig, $form); } + # get tax zones + $query = qq|SELECT id, description + FROM tax_zones|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{TAXZONE} }, $ref; + } + $sth->finish; + + my $rc = $dbh->commit; $dbh->disconnect; @@ -823,11 +948,18 @@ sub order_details { my $dbh = $form->dbconnect($myconfig); my $query; my $sth; - + my $nodiscount; + my $yesdiscount; + my $nodiscount_subtotal = 0; + my $discount_subtotal = 0; my $item; my $i; my @partsgroup = (); my $partsgroup; + my $position = 0; + my $subtotal_header = 0; + my $subposition = 0; + my %oid = ('Pg' => 'oid', 'Oracle' => 'rowid'); @@ -835,7 +967,6 @@ sub order_details { for $i (1 .. $form->{rowcount}) { $partsgroup = ""; if ($form->{"partsgroup_$i"} && $form->{groupitems}) { - $form->format_string("partsgroup_$i"); $partsgroup = $form->{"partsgroup_$i"}; } push @partsgroup, [$i, $partsgroup]; @@ -882,9 +1013,25 @@ sub order_details { if ($form->{"qty_$i"} != 0) { # add number, description and qty to $form->{number}, .... + + if ($form->{"subtotal_$i"} && !$subtotal_header) { + $subtotal_header = $i; + $position = int($position); + $subposition = 0; + $position++; + } elsif ($subtotal_header) { + $subposition += 1; + $position = int($position); + $position = $position.".".$subposition; + } else { + $position = int($position); + $position++; + } + push(@{ $form->{runningnumber} }, $i); push(@{ $form->{number} }, qq|$form->{"partnumber_$i"}|); push(@{ $form->{description} }, qq|$form->{"description_$i"}|); + push(@{ $form->{longdescription} }, qq|$form->{"longdescription_$i"}|); push(@{ $form->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"})); push(@{ $form->{ship} }, @@ -916,7 +1063,8 @@ sub order_details { # keep a netprice as well, (sellprice - discount) #$form->{"netprice_$i"} = $sellprice - $discount; $form->{"netprice_$i"} = $sellprice - $i_discount; - + my $nodiscount_linetotal = + $form->round_amount($form->{"qty_$i"} * $sellprice, 2); my $linetotal = $form->round_amount($form->{"qty_$i"} * $form->{"netprice_$i"}, 2); @@ -938,9 +1086,31 @@ sub order_details { push(@{ $form->{p_discount} }, $form->{"discount_$i"}); $form->{ordtotal} += $linetotal; + $discount_subtotal += $linetotal; + $form->{nodiscount_total} += $nodiscount_linetotal; + $nodiscount_subtotal += $nodiscount_linetotal; + $form->{discount_total} += $form->parse_amount($myconfig, $discount); + + if ($form->{"subtotal_$i"} && $subtotal_header && ($subtotal_header != $i)) { + $discount_subtotal = $form->format_amount($myconfig, $discount_subtotal, 2); + push(@{ $form->{discount_sub} }, $discount_subtotal); + $nodiscount_subtotal = $form->format_amount($myconfig, $nodiscount_subtotal, 2); + push(@{ $form->{nodiscount_sub} }, $nodiscount_subtotal); + $discount_subtotal = 0; + $nodiscount_subtotal = 0; + $subtotal_header = 0; + } else { + push(@{ $form->{discount_sub} }, ""); + push(@{ $form->{nodiscount_sub} }, ""); + } + if ($linetotal == $netto_linetotal) { + $nodiscount += $linetotal; + } push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2)); + push(@{ $form->{nodiscount_linetotal} }, + $form->format_amount($myconfig, $nodiscount_linetotal, 2)); my ($taxamount, $taxbase); my $taxrate = 0; @@ -995,7 +1165,7 @@ sub order_details { while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { if ($form->{groupitems} && $ref->{partsgroup} ne $sameitem) { map { push(@{ $form->{$_} }, "") } - qw(runningnumber ship bin serialnumber number unit bin qty reqdate sellprice listprice netprice discount linetotal); + qw(runningnumber ship bin serialnumber number unit bin qty reqdate sellprice listprice netprice discount linetotal nodiscount_linetotal); $sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--"; push(@{ $form->{description} }, $sameitem); } @@ -1006,7 +1176,7 @@ sub order_details { . qq|, $ref->{partnumber}, $ref->{description}|); map { push(@{ $form->{$_} }, "") } - qw(number unit qty runningnumber ship bin serialnumber reqdate sellprice listprice netprice discount linetotal); + qw(number unit qty runningnumber ship bin serialnumber reqdate sellprice listprice netprice discount linetotal nodiscount_linetotal); } $sth->finish; @@ -1017,7 +1187,6 @@ sub order_details { my $tax = 0; foreach $item (sort keys %taxaccounts) { - if ($form->round_amount($taxaccounts{$item}, 2) != 0) { push(@{ $form->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2)); @@ -1028,8 +1197,13 @@ sub order_details { push(@{ $form->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); push(@{ $form->{taxnumber} }, $form->{"${item}_taxnumber"}); - } } + $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); + $yesdiscount = $form->{nodiscount_total} - $nodiscount; + $form->{nodiscount_subtotal} = $form->format_amount($myconfig, $form->{nodiscount_total}, 2); + $form->{discount_total} = $form->format_amount($myconfig, $form->{discount_total}, 2); + $form->{nodiscount} = $form->format_amount($myconfig, $nodiscount, 2); + $form->{yesdiscount} = $form->format_amount($myconfig, $yesdiscount, 2); $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); $form->{ordtotal} = @@ -1039,6 +1213,12 @@ sub order_details { $form->{quototal} = $form->{ordtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); + if ($form->{type} =~ /_quotation/) { + $form->set_payment_options($myconfig, $form->{quodate}); + } else { + $form->set_payment_options($myconfig, $form->{orddate}); + } + # myconfig variables map { $form->{$_} = $myconfig->{$_} } (qw(company address tel fax signature businessnumber)); @@ -1200,7 +1380,10 @@ sub adj_onhand { my ($dbh, $form, $ml) = @_; - my $query = qq|SELECT oi.parts_id, oi.ship, p.inventory_accno_id, p.assembly + my $service_units = $form->{service_units}; + my $part_units = $form->{part_units}; + + my $query = qq|SELECT oi.parts_id, oi.ship, oi.unit, p.inventory_accno_id, p.assembly FROM orderitems oi JOIN parts p ON (p.id = oi.parts_id) WHERE oi.trans_id = $form->{id}|; @@ -1216,6 +1399,7 @@ sub adj_onhand { my $ispa; while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + #print(STDERR "Bin in Schleife $ref->{inventory_accno_id}\n"); if ($ref->{inventory_accno_id} || $ref->{assembly}) { @@ -1230,10 +1414,37 @@ sub adj_onhand { } + # get item baseunit + $query = qq|SELECT p.unit + FROM parts p + WHERE p.id = $ref->{parts_id}|; + my $stw = $dbh->prepare($query); + $stw->execute || $form->dberror($query); + + my ($item_unit) = $stw->fetchrow_array(); + $stw->finish; + + if ($ref->{inventory_accno_id}) { + if (defined($part_units->{$item_unit}->{factor}) && $part_units->{$item_unit}->{factor} ne '' && $part_units->{$item_unit}->{factor} ne '0') { + $basefactor = $part_units->{$ref->{unit}}->{factor} / $part_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $ref->{ship} * $basefactor; + } else { + if (defined($service_units->{$item_unit}->{factor}) && $service_units->{$item_unit}->{factor} ne '' && $service_units->{$item_unit}->{factor} ne '0') { + $basefactor = $service_units->{$ref->{unit}}->{factor} / $part_units->{$item_unit}->{factor}; + } else { + $basefactor = 1; + } + $baseqty = $ref->{ship} * $basefactor; + } + #print(STDERR "$baseqty Basismenge\n"); + # adjust onhand in parts table $form->update_balance($dbh, "parts", "onhand", qq|id = $ref->{parts_id}|, - $ref->{ship} * $ml); + $baseqty * $ml); } } diff --git a/SL/RC.pm b/SL/RC.pm index 63a41f434..6de28ab65 100644 --- a/SL/RC.pm +++ b/SL/RC.pm @@ -73,7 +73,7 @@ sub payment_transactions { if ($form->{fromdate}) { $query = qq|SELECT sum(a.amount), (SELECT DISTINCT c2.category FROM chart c2 - WHERE c2accno = '$form->{accno}') AS category + WHERE c2.accno = '$form->{accno}') AS category FROM acc_trans a JOIN chart c ON (c.id = a.chart_id) WHERE a.transdate < date '$form->{fromdate}' diff --git a/SL/Template.pm b/SL/Template.pm new file mode 100644 index 000000000..27ebb36a3 --- /dev/null +++ b/SL/Template.pm @@ -0,0 +1,1321 @@ +#==================================================================== +# LX-Office ERP +# Copyright (C) 2004 +# Based on SQL-Ledger Version 2.1.9 +# Web http://www.lx-office.org +# +#==================================================================== + +package SimpleTemplate; + +# Parameters: +# 1. The template's file name +# 2. A reference to the Form object +# 3. A reference to the myconfig hash +# +# Returns: +# A new template object +sub new { + my $type = shift; + my $self = {}; + + bless($self, $type); + $self->_init(@_); + + return $self; +} + +sub _init { + my $self = shift; + + $self->{"source"} = shift; + $self->{"form"} = shift; + $self->{"myconfig"} = shift; + $self->{"userspath"} = shift; + + $self->{"error"} = undef; +} + +sub cleanup { + my ($self) = @_; +} + +# Parameters: +# 1. A typeglob for the file handle. The output will be written +# to this file handle. +# +# Returns: +# 1 on success and undef or 0 if there was an error. In the latter case +# the calling function can retrieve the error message via $obj->get_error() +sub parse { + my $self = $_[0]; + local *OUT = $_[1]; + + print(OUT "Hallo!\n"); +} + +sub get_error { + my $self = shift; + + return $self->{"error"}; +} + +sub uses_temp_file { + return 0; +} + +1; + +#### +#### LaTeXTemplate +#### + +package LaTeXTemplate; + +use vars qw(@ISA); + +@ISA = qw(SimpleTemplate); + +sub new { + my $type = shift; + + return $type->SUPER::new(@_); +} + +sub format_string { + my ($self, $variable) = @_; + my $form = $self->{"form"}; + + my %replace = + ('order' => [quotemeta("\\"), + '', + '&', quotemeta("\n"), + '"', '\$', '%', '_', '#', quotemeta('^'), + '{', '}', '<', '>', '£', "\r" + ], + quotemeta("\\") => '\\textbackslash ', + '' => '', + '"' => "''", + '&' => '\&', + '\$' => '\$', + '%' => '\%', + '_' => '\_', + '#' => '\#', + '{' => '\{', + '}' => '\}', + '<' => '$<$', + '>' => '$>$', + '£' => '\pounds ', + "\r" => "", + quotemeta('^') => '\^\\', + quotemeta("\n") => '\newline ' + ); + + map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + # Allow some HTML markup to be converted into the output format's + # corresponding markup code, e.g. bold or italic. + my %markup_replace = ('b' => 'textbf', + 'i' => 'textit', + 'u' => 'underline'); + + foreach my $key (keys(%markup_replace)) { + my $new = $markup_replace{$key}; + $variable =~ s/\$\<\$${key}\$\>\$(.*?)\$<\$\/${key}\$>\$/\\${new}\{$1\}/gi; + } + + return $variable; +} + +sub substitute_vars { + my ($self, $text, @indices) = @_; + + my $form = $self->{"form"}; + + while ($text =~ /<\%(.*?)\%>/) { + my ($var, @options) = split(/\s+/, $1); + my $value = $form->{$var}; + + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($value) eq "ARRAY"); + $value = $value->[$indices[$i]]; + } + $value = $self->format_string($value) unless (grep(/^NOESCAPE$/, @options)); + substr($text, $-[0], $+[0] - $-[0]) = $value; + } + + return $text; +} + +sub parse_foreach { + my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_; + + my ($form, $new_contents) = ($self->{"form"}, ""); + + my $ary = $form->{$var}; + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($ary) eq "ARRAY"); + $ary = $ary->[$indices[$i]]; + } + + my $sum = 0; + my $current_page = 1; + my ($current_line, $corrent_row) = (0, 1); + + for (my $i = 0; $i < scalar(@{$ary}); $i++) { + $form->{"__first__"} = $i == 0; + $form->{"__last__"} = ($i + 1) == scalar(@{$ary}); + $form->{"__odd__"} = (($i + 1) % 2) == 1; + $form->{"__counter__"} = $i + 1; + + if ((scalar(@{$form->{"description"}}) == scalar(@{$ary})) && + $self->{"chars_per_line"}) { + my $lines = + int(length($form->{"description"}->[$i]) / $self->{"chars_per_line"}); + my $lpp; + + $form->{"description"}->[$i] =~ s/(\\newline\s?)*$//; + my $_description = $form->{"description"}->[$i]; + while ($_description =~ /\\newline/) { + $lines++; + $_description =~ s/\\newline//; + } + $lines++; + + if ($current_page == 1) { + $lpp = $self->{"lines_on_first_page"}; + } else { + $lpp = $self->{"lines_on_second_page"}; + } + + # Yes we need a manual page break -- or the user has forced one + if ((($current_line + $lines) > $lpp) || + ($form->{"description"}->[$i] =~ //)) { + my $pb = $self->{"pagebreak_block"}; + + # replace the special variables <%sumcarriedforward%> + # and <%lastpage%> + + my $psum = $form->format_amount($self->{"myconfig"}, $sum, 2); + $pb =~ s/<%sumcarriedforward%>/$psum/g; + $pb =~ s/<%lastpage%>/$current_page/g; + + my $new_text = $self->parse_block($pb, (@indices, $i)); + return undef unless (defined($new_text)); + $new_contents .= $new_text; + + $current_page++; + $current_line = 0; + } + $current_line += $lines; + } + if ($i < scalar(@{$form->{"linetotal"}})) { + $sum += $form->parse_amount($self->{"myconfig"}, + $form->{"linetotal"}->[$i]); + } + + my $new_text = $self->parse_block($text, (@indices, $i)); + return undef unless (defined($new_text)); + $new_contents .= $start_tag . $new_text . $end_tag; + } + map({ delete($form->{"__${_}__"}); } qw(first last odd counter)); + + return $new_contents; +} + +sub find_end { + my ($self, $text, $pos, $var, $not) = @_; + + my $depth = 1; + $pos = 0 unless ($pos); + + while ($pos < length($text)) { + $pos++; + + next if (substr($text, $pos - 1, 2) ne '<%'); + + if ((substr($text, $pos + 1, 2) eq 'if') || (substr($text, $pos + 1, 3) eq 'for')) { + $depth++; + + } elsif ((substr($text, $pos + 1, 4) eq 'else') && (1 == $depth)) { + if (!$var) { + $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.'; + return undef; + } + + my $block = substr($text, 0, $pos - 1); + substr($text, 0, $pos - 1) = ""; + $text =~ s!^<\%[^\%]+\%>!!; + $text = '<%if' . ($not ? " " : "not ") . $var . '%>' . $text; + + return ($block, $text); + + } elsif (substr($text, $pos + 1, 3) eq 'end') { + $depth--; + if ($depth == 0) { + my $block = substr($text, 0, $pos - 1); + substr($text, 0, $pos - 1) = ""; + $text =~ s!^<\%[^\%]+\%>!!; + + return ($block, $text); + } + } + } + + return undef; +} + +sub parse_block { + $main::lxdebug->enter_sub(); + + my ($self, $contents, @indices) = @_; + + my $new_contents = ""; + + while ($contents ne "") { + my $pos_if = index($contents, '<%if'); + my $pos_foreach = index($contents, '<%foreach'); + + if ((-1 == $pos_if) && (-1 == $pos_foreach)) { + $new_contents .= $self->substitute_vars($contents, @indices); + last; + } + + if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) { + $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices); + substr($contents, 0, $pos_foreach) = ""; + + if ($contents !~ m|^<\%foreach (.*?)\%>|) { + $self->{"error"} = "Malformed <\%foreach\%>."; + $main::lxdebug->leave_sub(); + return undef; + } + + my $var = $1; + + substr($contents, 0, length($&)) = ""; + + my $block; + ($block, $contents) = $self->find_end($contents); + if (!$block) { + $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"}); + $main::lxdebug->leave_sub(); + return undef; + } + + my $new_text = $self->parse_foreach($var, $block, "", "", @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $new_text; + + } else { + $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices); + substr($contents, 0, $pos_if) = ""; + + if ($contents !~ m|^<\%if\s*(not)?\s+(.*?)\%>|) { + $self->{"error"} = "Malformed <\%if\%>."; + $main::lxdebug->leave_sub(); + return undef; + } + + my ($not, $var) = ($1, $2); + + substr($contents, 0, length($&)) = ""; + + ($block, $contents) = $self->find_end($contents, 0, $var, $not); + if (!$block) { + $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"}); + $main::lxdebug->leave_sub(); + return undef; + } + + my $value = $self->{"form"}->{$var}; + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($value) eq "ARRAY"); + $value = $value->[$indices[$i]]; + } + + if (($not && !$value) || (!$not && $value)) { + my $new_text = $self->parse_block($block, @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $new_text; + } + } + } + + $main::lxdebug->leave_sub(); + + return $new_contents; +} + +sub parse { + my $self = $_[0]; + local *OUT = $_[1]; + my $form = $self->{"form"}; + + if (!open(IN, "$form->{templates}/$form->{IN}")) { + $self->{"error"} = "$!"; + return 0; + } + @_ = ; + close(IN); + + my $contents = join("", @_); + + # detect pagebreak block and its parameters + if ($contents =~ /<%pagebreak\s+(\d+)\s+(\d+)\s+(\d+)\s*%>(.*?)<%end(\s*pagebreak)?%>/s) { + $self->{"chars_per_line"} = $1; + $self->{"lines_on_first_page"} = $2; + $self->{"lines_on_second_page"} = $3; + $self->{"pagebreak_block"} = $4; + + substr($contents, length($`), length($&)) = ""; + } + + $self->{"forced_pagebreaks"} = []; + + my $new_contents = $self->parse_block($contents); + if (!defined($new_contents)) { + $main::lxdebug->leave_sub(); + return 0; + } + + print(OUT $new_contents); + + if ($form->{"format"} =~ /postscript/i) { + return $self->convert_to_postscript(); + } elsif ($form->{"format"} =~ /pdf/i) { + return $self->convert_to_pdf(); + } else { + return 1; + } +} + +sub convert_to_postscript { + my ($self) = @_; + my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"}); + + # Convert the tex file to postscript + + if (!chdir("$userspath")) { + $self->{"error"} = "chdir : $!"; + $self->cleanup(); + return 0; + } + + $form->{tmpfile} =~ s/$userspath\///g; + + for (my $run = 1; $run <= 2; $run++) { + system("latex --interaction=nonstopmode $form->{tmpfile} " . + "> $form->{tmpfile}.err"); + if ($?) { + $self->{"error"} = $form->cleanup(); + $self->cleanup(); + return 0; + } + } + + $form->{tmpfile} =~ s/tex$/dvi/; + + system("dvips $form->{tmpfile} -o -q > /dev/null"); + if ($?) { + $self->{"error"} = "dvips : $!"; + $self->cleanup(); + return 0; + } + $form->{tmpfile} =~ s/dvi$/ps/; + + $self->cleanup(); + + return 1; +} + +sub convert_to_pdf { + my ($self) = @_; + my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"}); + + # Convert the tex file to PDF + + if (!chdir("$userspath")) { + $self->{"error"} = "chdir : $!"; + $self->cleanup(); + return 0; + } + + $form->{tmpfile} =~ s/$userspath\///g; + + for (my $run = 1; $run <= 2; $run++) { + system("pdflatex --interaction=nonstopmode $form->{tmpfile} " . + "> $form->{tmpfile}.err"); + if ($?) { + $self->{"error"} = $form->cleanup(); + $self->cleanup(); + return 0; + } + } + + $form->{tmpfile} =~ s/tex$/pdf/; + + $self->cleanup(); +} + +sub get_mime_type() { + my ($self) = @_; + + if ($self->{"form"}->{"format"} =~ /postscript/i) { + return "application/postscript"; + } else { + return "application/pdf"; + } +} + +sub uses_temp_file { + return 1; +} + + +#### +#### HTMLTemplate +#### + +package HTMLTemplate; + +use vars qw(@ISA); + +@ISA = qw(LaTeXTemplate); + +sub new { + my $type = shift; + + return $type->SUPER::new(@_); +} + +sub format_string { + my ($self, $variable) = @_; + my $form = $self->{"form"}; + + my %replace = + ('order' => ['<', '>', quotemeta("\n")], + '<' => '<', + '>' => '>', + quotemeta("\n") => '
', + ); + + map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + # Allow some HTML markup to be converted into the output format's + # corresponding markup code, e.g. bold or italic. + my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup'); + + foreach my $key (@markup_replace) { + $variable =~ s/\<(\/?)${key}\>/<$1${key}>/g; + } + + return $variable; +} + +sub get_mime_type() { + my ($self) = @_; + + if ($self->{"form"}->{"format"} =~ /postscript/i) { + return "application/postscript"; + } elsif ($self->{"form"}->{"format"} =~ /pdf/i) { + return "application/pdf"; + } else { + return "text/html"; + } +} + +sub uses_temp_file { + my ($self) = @_; + + if ($self->{"form"}->{"format"} =~ /postscript/i) { + return 1; + } elsif ($self->{"form"}->{"format"} =~ /pdf/i) { + return 1; + } else { + return 0; + } +} + +sub convert_to_postscript { + my ($self) = @_; + my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"}); + + # Convert the HTML file to postscript + + if (!chdir("$userspath")) { + $self->{"error"} = "chdir : $!"; + $self->cleanup(); + return 0; + } + + $form->{"tmpfile"} =~ s/$userspath\///g; + my $psfile = $form->{"tmpfile"}; + $psfile =~ s/.html/.ps/; + if ($psfile eq $form->{"tmpfile"}) { + $psfile .= ".ps"; + } + + system("html2ps -f html2ps-config < $form->{tmpfile} > $psfile"); + if ($?) { + $self->{"error"} = $form->cleanup(); + $self->cleanup(); + return 0; + } + + $form->{"tmpfile"} = $psfile; + + $self->cleanup(); + + return 1; +} + +sub convert_to_pdf { + my ($self) = @_; + my ($form, $userspath) = ($self->{"form"}, $self->{"userspath"}); + + # Convert the HTML file to PDF + + if (!chdir("$userspath")) { + $self->{"error"} = "chdir : $!"; + $self->cleanup(); + return 0; + } + + $form->{"tmpfile"} =~ s/$userspath\///g; + my $pdffile = $form->{"tmpfile"}; + $pdffile =~ s/.html/.pdf/; + if ($pdffile eq $form->{"tmpfile"}) { + $pdffile .= ".pdf"; + } + + system("html2ps -f html2ps-config < $form->{tmpfile} | ps2pdf - $pdffile"); + if ($?) { + $self->{"error"} = $form->cleanup(); + $self->cleanup(); + return 0; + } + + $form->{"tmpfile"} = $pdffile; + + $self->cleanup(); + + return 1; +} + + +#### +#### OpenDocumentTemplate +#### + +package OpenDocumentTemplate; + +use POSIX 'setsid'; +use vars qw(@ISA); + +use Cwd; +# use File::Copy; +# use File::Spec; +# use File::Temp qw(:mktemp); +use IO::File; + +@ISA = qw(SimpleTemplate); + +sub new { + my $type = shift; + + $self = $type->SUPER::new(@_); + + foreach my $module (qw(Archive::Zip Text::Iconv)) { + eval("use ${module};"); + if ($@) { + $self->{"form"}->error("The Perl module '${module}' could not be " . + "loaded. Support for OpenDocument templates " . + "does not work without it. Please install your " . + "distribution's package or get the module from " . + "CPAN ( http://www.cpan.org )."); + } + } + + $self->{"rnd"} = int(rand(1000000)); + $self->{"iconv"} = Text::Iconv->new($main::dbcharset, "UTF-8"); + + return $self; +} + +sub substitute_vars { + my ($self, $text, @indices) = @_; + + my $form = $self->{"form"}; + + while ($text =~ /\<\%(.*?)\%\>/) { + my $value = $form->{$1}; + + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($value) eq "ARRAY"); + $value = $value->[$indices[$i]]; + } + substr($text, $-[0], $+[0] - $-[0]) = $self->format_string($value); + } + + return $text; +} + +sub parse_foreach { + my ($self, $var, $text, $start_tag, $end_tag, @indices) = @_; + + my ($form, $new_contents) = ($self->{"form"}, ""); + + my $ary = $form->{$var}; + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($ary) eq "ARRAY"); + $ary = $ary->[$indices[$i]]; + } + + for (my $i = 0; $i < scalar(@{$ary}); $i++) { + $form->{"__first__"} = $i == 0; + $form->{"__last__"} = ($i + 1) == scalar(@{$ary}); + $form->{"__odd__"} = (($i + 1) % 2) == 1; + $form->{"__counter__"} = $i + 1; + my $new_text = $self->parse_block($text, (@indices, $i)); + return undef unless (defined($new_text)); + $new_contents .= $start_tag . $new_text . $end_tag; + } + map({ delete($form->{"__${_}__"}); } qw(first last odd counter)); + + return $new_contents; +} + +sub find_end { + my ($self, $text, $pos, $var, $not) = @_; + + my $depth = 1; + $pos = 0 unless ($pos); + + while ($pos < length($text)) { + $pos++; + + next if (substr($text, $pos - 1, 5) ne '<%'); + + if ((substr($text, $pos + 4, 2) eq 'if') || (substr($text, $pos + 4, 3) eq 'for')) { + $depth++; + + } elsif ((substr($text, $pos + 4, 4) eq 'else') && (1 == $depth)) { + if (!$var) { + $self->{"error"} = '<%else%> outside of <%if%> / <%ifnot%>.'; + return undef; + } + + my $block = substr($text, 0, $pos - 1); + substr($text, 0, $pos - 1) = ""; + $text =~ s!^\<\%[^\%]+\%\>!!; + $text = '<%if' . ($not ? " " : "not ") . $var . '%>' . $text; + + return ($block, $text); + + } elsif (substr($text, $pos + 4, 3) eq 'end') { + $depth--; + if ($depth == 0) { + my $block = substr($text, 0, $pos - 1); + substr($text, 0, $pos - 1) = ""; + $text =~ s!^\<\%[^\%]+\%\>!!; + + return ($block, $text); + } + } + } + + return undef; +} + +sub parse_block { + $main::lxdebug->enter_sub(); + + my ($self, $contents, @indices) = @_; + + my $new_contents = ""; + + while ($contents ne "") { + if (substr($contents, 0, 1) eq "<") { + $contents =~ m|^<[^>]+>|; + my $tag = $&; + substr($contents, 0, length($&)) = ""; + + if ($tag =~ m|]*>)|; + my $table_row = $1; + my $end_tag = $2; + substr($contents, 0, length($1) + length($end_tag)) = ""; + + if ($table_row =~ m|\<\%foreachrow\s+(.*?)\%\>|) { + my $var = $1; + + substr($table_row, length($`), length($&)) = ""; + + my ($t1, $t2) = $self->find_end($table_row, length($`)); + if (!$t1) { + $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"}); + $main::lxdebug->leave_sub(); + return undef; + } + + my $new_text = $self->parse_foreach($var, $t1 . $t2, $tag, $end_tag, @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $new_text; + + } else { + my $new_text = $self->parse_block($table_row, @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $tag . $new_text . $end_tag; + } + + } else { + $new_contents .= $tag; + } + + } else { + $contents =~ /^[^<]+/; + my $text = $&; + + my $pos_if = index($text, '<%if'); + my $pos_foreach = index($text, '<%foreach'); + + if ((-1 == $pos_if) && (-1 == $pos_foreach)) { + substr($contents, 0, length($text)) = ""; + $new_contents .= $self->substitute_vars($text, @indices); + next; + } + + if ((-1 == $pos_if) || ((-1 != $pos_foreach) && ($pos_if > $pos_foreach))) { + $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices); + substr($contents, 0, $pos_foreach) = ""; + + if ($contents !~ m|^\<\%foreach (.*?)\%\>|) { + $self->{"error"} = "Malformed <\%foreach\%>."; + $main::lxdebug->leave_sub(); + return undef; + } + + my $var = $1; + + substr($contents, 0, length($&)) = ""; + + my $block; + ($block, $contents) = $self->find_end($contents); + if (!$block) { + $self->{"error"} = "Unclosed <\%foreach\%>." unless ($self->{"error"}); + $main::lxdebug->leave_sub(); + return undef; + } + + my $new_text = $self->parse_foreach($var, $block, "", "", @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $new_text; + + } else { + $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_if), @indices); + substr($contents, 0, $pos_if) = ""; + + if ($contents !~ m|^\<\%if\s*(not)?\s+(.*?)\%\>|) { + $self->{"error"} = "Malformed <\%if\%>."; + $main::lxdebug->leave_sub(); + return undef; + } + + my ($not, $var) = ($1, $2); + + substr($contents, 0, length($&)) = ""; + + ($block, $contents) = $self->find_end($contents, 0, $var, $not); + if (!$block) { + $self->{"error"} = "Unclosed <\%if${not}\%>." unless ($self->{"error"}); + $main::lxdebug->leave_sub(); + return undef; + } + + my $value = $self->{"form"}->{$var}; + for (my $i = 0; $i < scalar(@indices); $i++) { + last unless (ref($value) eq "ARRAY"); + $value = $value->[$indices[$i]]; + } + + if (($not && !$value) || (!$not && $value)) { + my $new_text = $self->parse_block($block, @indices); + if (!defined($new_text)) { + $main::lxdebug->leave_sub(); + return undef; + } + $new_contents .= $new_text; + } + } + } + } + + $main::lxdebug->leave_sub(); + + return $new_contents; +} + +sub parse { + $main::lxdebug->enter_sub(); + + my $self = $_[0]; + local *OUT = $_[1]; + my $form = $self->{"form"}; + + close(OUT); + + my $file_name; + if ($form->{"IN"} =~ m|^/|) { + $file_name = $form->{"IN"}; + } else { + $file_name = $form->{"templates"} . "/" . $form->{"IN"}; + } + + my $zip = Archive::Zip->new(); + if (Archive::Zip::AZ_OK != $zip->read($file_name)) { + $self->{"error"} = "File not found/is not a OpenDocument file."; + $main::lxdebug->leave_sub(); + return 0; + } + + my $contents = $zip->contents("content.xml"); + if (!$contents) { + $self->{"error"} = "File is not a OpenDocument file."; + $main::lxdebug->leave_sub(); + return 0; + } + + my $rnd = $self->{"rnd"}; + my $new_styles = qq| + + + + + + + + + + + + + + + + + +|; + + $contents =~ s||${new_styles}|; + $contents =~ s|[\n\r]||gm; + + my $new_contents = $self->parse_block($contents); + if (!defined($new_contents)) { + $main::lxdebug->leave_sub(); + return 0; + } + +# $new_contents =~ s|>|>\n|g; + + $zip->contents("content.xml", $new_contents); + + my $styles = $zip->contents("styles.xml"); + if ($contents) { + my $new_styles = $self->parse_block($styles); + if (!defined($new_contents)) { + $main::lxdebug->leave_sub(); + return 0; + } + $zip->contents("styles.xml", $new_styles); + } + + $zip->writeToFileNamed($form->{"tmpfile"}, 1); + + my $res = 1; + if ($form->{"format"} =~ /pdf/) { + $res = $self->convert_to_pdf(); + } + + $main::lxdebug->leave_sub(); + return $res; +} + +sub is_xvfb_running { + $main::lxdebug->enter_sub(); + + my ($self) = @_; + + local *IN; + my $dfname = $self->{"userspath"} . "/xvfb_display"; + my $display; + + $main::lxdebug->message(LXDebug::DEBUG2, " Looking for $dfname\n"); + if ((-f $dfname) && open(IN, $dfname)) { + my $pid = ; + chomp($pid); + $display = ; + chomp($display); + my $xauthority = ; + chomp($xauthority); + close(IN); + + $main::lxdebug->message(LXDebug::DEBUG2, " found with $pid and $display\n"); + + if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) { + $main::lxdebug->message(LXDebug::DEBUG2, " no/wrong process #1\n"); + unlink($dfname, $xauthority); + $main::lxdebug->leave_sub(); + return undef; + } + my $line = ; + close(IN); + if ($line !~ /xvfb/i) { + $main::lxdebug->message(LXDebug::DEBUG2, " no/wrong process #2\n"); + unlink($dfname, $xauthority); + $main::lxdebug->leave_sub(); + return undef; + } + + $ENV{"XAUTHORITY"} = $xauthority; + $ENV{"DISPLAY"} = $display; + } else { + $main::lxdebug->message(LXDebug::DEBUG2, " not found\n"); + } + + $main::lxdebug->leave_sub(); + + return $display; +} + +sub spawn_xvfb { + $main::lxdebug->enter_sub(); + + my ($self) = @_; + + $main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n"); + + my $display = $self->is_xvfb_running(); + + if ($display) { + $main::lxdebug->leave_sub(); + return $display; + } + + $display = 99; + while ( -f "/tmp/.X${display}-lock") { + $display++; + } + $display = ":${display}"; + $main::lxdebug->message(LXDebug::DEBUG2, " display $display\n"); + + my $mcookie = `mcookie`; + die("Installation error: mcookie not found.") if ($? != 0); + chomp($mcookie); + + $main::lxdebug->message(LXDebug::DEBUG2, " mcookie $mcookie\n"); + + my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999)); + $ENV{"XAUTHORITY"} = $xauthority; + + $main::lxdebug->message(LXDebug::DEBUG2, " xauthority $xauthority\n"); + + system("xauth add \"${display}\" . \"${mcookie}\""); + if ($? != 0) { + $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)"; + $main::lxdebug->leave_sub(); + return undef; + } + + $main::lxdebug->message(LXDebug::DEBUG2, " about to fork()\n"); + + my $pid = fork(); + if (0 == $pid) { + $main::lxdebug->message(LXDebug::DEBUG2, " Child execing\n"); + exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp"); + } + sleep(3); + $main::lxdebug->message(LXDebug::DEBUG2, " parent dont sleeping\n"); + + local *OUT; + my $dfname = $self->{"userspath"} . "/xvfb_display"; + if (!open(OUT, ">$dfname")) { + $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started ($dfname: $!)"; + unlink($xauthority); + kill($pid); + $main::lxdebug->leave_sub(); + return undef; + } + print(OUT "$pid\n$display\n$xauthority\n"); + close(OUT); + + $main::lxdebug->message(LXDebug::DEBUG2, " parent re-testing\n"); + + if (!$self->is_xvfb_running()) { + $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started."; + unlink($xauthority, $dfname); + kill($pid); + $main::lxdebug->leave_sub(); + return undef; + } + + $main::lxdebug->message(LXDebug::DEBUG2, " spawn OK\n"); + + $main::lxdebug->leave_sub(); + + return $display; +} + +sub is_openoffice_running { + $main::lxdebug->enter_sub(); + + system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " . + "> /dev/null 2> /dev/null"); + my $res = $? == 0; + $main::lxdebug->message(LXDebug::DEBUG2, " is_openoffice_running(): $?\n"); + + $main::lxdebug->leave_sub(); + + return $res; +} + +sub spawn_openoffice { + $main::lxdebug->enter_sub(); + + my ($self) = @_; + + $main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n"); + + my ($try, $spawned_oo, $res); + + $res = 0; + for ($try = 0; $try < 15; $try++) { + if ($self->is_openoffice_running()) { + $res = 1; + last; + } + + if (!$spawned_oo) { + my $pid = fork(); + if (0 == $pid) { + $main::lxdebug->message(LXDebug::DEBUG2, " Child daemonizing\n"); + chdir('/'); + open(STDIN, '/dev/null'); + open(STDOUT, '>/dev/null'); + my $new_pid = fork(); + exit if ($new_pid); + my $ssres = setsid(); + $main::lxdebug->message(LXDebug::DEBUG2, " Child execing\n"); + my @cmdline = ($main::openofficeorg_writer_bin, + "-minimized", "-norestore", "-nologo", "-nolockcheck", + "-headless", + "-accept=socket,host=localhost,port=" . + $main::openofficeorg_daemon_port . ";urp;"); + exec(@cmdline); + } + + $main::lxdebug->message(LXDebug::DEBUG2, " Parent after fork\n"); + $spawned_oo = 1; + sleep(3); + } + + sleep($try >= 5 ? 2 : 1); + } + + if (!$res) { + $self->{"error"} = "Conversion from OpenDocument to PDF failed because " . + "OpenOffice could not be started."; + } + + $main::lxdebug->leave_sub(); + + return $res; +} + +sub convert_to_pdf { + $main::lxdebug->enter_sub(); + + my ($self) = @_; + + my $form = $self->{"form"}; + + my $filename = $form->{"tmpfile"}; + $filename =~ s/.odt$//; + if (substr($filename, 0, 1) ne "/") { + $filename = getcwd() . "/${filename}"; + } + + if (substr($self->{"userspath"}, 0, 1) eq "/") { + $ENV{'HOME'} = $self->{"userspath"}; + } else { + $ENV{'HOME'} = getcwd() . "/" . $self->{"userspath"}; + } + + if (!$self->spawn_xvfb()) { + $main::lxdebug->leave_sub(); + return 0; + } + + my @cmdline; + if (!$main::openofficeorg_daemon) { + @cmdline = ($main::openofficeorg_writer_bin, + "-minimized", "-norestore", "-nologo", "-nolockcheck", + "-headless", + "file:${filename}.odt", + "macro://" . (split('/', $filename))[-1] . + "/Standard.Conversion.ConvertSelfToPDF()"); + } else { + if (!$self->spawn_openoffice()) { + $main::lxdebug->leave_sub(); + return 0; + } + + @cmdline = ("./scripts/oo-uno-convert-pdf.py", + $main::openofficeorg_daemon_port, + "${filename}.odt"); + } + + system(@cmdline); + + my $res = $?; + if (0 == $?) { + $form->{"tmpfile"} =~ s/odt$/pdf/; + + unlink($filename . ".odt"); + + $main::lxdebug->leave_sub(); + return 1; + + } + + unlink($filename . ".odt", $filename . ".pdf"); + $self->{"error"} = "Conversion from OpenDocument to PDF failed. " . + "Exit code: $res"; + + $main::lxdebug->leave_sub(); + return 0; +} + +sub format_string { + my ($self, $variable) = @_; + my $form = $self->{"form"}; + my $iconv = $self->{"iconv"}; + + my %replace = + ('order' => ['&', '<', '>', '"', "'", + '\x80', # Euro + quotemeta("\n"), quotemeta("\r")], + '<' => '<', + '>' => '>', + '"' => '"', + "'" => ''', + '&' => '&', + '\x80' => chr(0xa4), # Euro + quotemeta("\n") => '', + quotemeta("\r") => '', + ); + + map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + # Allow some HTML markup to be converted into the output format's + # corresponding markup code, e.g. bold or italic. + my $rnd = $self->{"rnd"}; + my %markup_replace = ("b" => "BOLD", "i" => "ITALIC", "s" => "STRIKETHROUGH", + "u" => "UNDERLINE", "sup" => "SUPER", "sub" => "SUB"); + + foreach my $key (keys(%markup_replace)) { + my $value = $markup_replace{$key}; + $variable =~ s|\<${key}\>||gi; + $variable =~ s|\</${key}\>||gi; + } + + return $iconv->convert($variable); +} + +sub get_mime_type() { + if ($self->{"form"}->{"format"} =~ /pdf/) { + return "application/pdf"; + } else { + return "application/vnd.oasis.opendocument.text"; + } +} + +sub uses_temp_file { + return 1; +} + + +########################################################## +#### +#### XMLTemplate +#### +########################################################## + +package XMLTemplate; + +use vars qw(@ISA); + +@ISA = qw(HTMLTemplate); + +sub new { + #evtl auskommentieren + my $type = shift; + + return $type->SUPER::new(@_); +} + +sub format_string { + my ($self, $variable) = @_; + my $form = $self->{"form"}; + + my %replace = + ('order' => ['<', '>', quotemeta("\n")], + '<' => '<', + '>' => '>', + quotemeta("\n") => '
', + ); + + map({ $variable =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); + + # Allow no markup to be converted into the output format + my @markup_replace = ('b', 'i', 's', 'u', 'sub', 'sup'); + + foreach my $key (@markup_replace) { + $variable =~ s/\<(\/?)${key}\>//g; + } + + return $variable; +} + +sub get_mime_type() { + my ($self) = @_; + + if ($self->{"form"}->{"format"} =~ /xml/i) { + return "application/xml "; + } else { + return "text/xml"; + } +} + +sub uses_temp_file { +# my ($self) = @_; + # no tempfile needet for XML Output + return 1; +} + +1; diff --git a/SL/USTVA.pm b/SL/USTVA.pm index 84dc4f312..505efb438 100644 --- a/SL/USTVA.pm +++ b/SL/USTVA.pm @@ -607,14 +607,12 @@ sub ustva { foreach $item (@categories_cent) { $form->{$item} = - $form->format_amount($myconfig, $form->round_amount($form->{$item}, 2), - 2, '0'); + $form->format_amount($myconfig, $form->{$item}, '2', '0'); } foreach $item (@categories_euro) { $form->{$item} = - $form->format_amount($myconfig, $form->round_amount($form->{$item}, 0), - 0, '0'); + $form->format_amount($myconfig, $form->{$item}, '0', '0'); } $dbh->disconnect; @@ -637,6 +635,7 @@ sub get_accounts_ustva { my $glwhere = ""; my $subwhere = ""; my $ARwhere = ""; + my $APwhere = ''; my $arwhere = ""; my $item; @@ -645,6 +644,7 @@ sub get_accounts_ustva { $subwhere .= " AND transdate >= '$fromdate'"; $glwhere = " AND ac.transdate >= '$fromdate'"; $ARwhere .= " AND acc.transdate >= '$fromdate'"; + $APwhere .= " AND AP.transdate >= '$fromdate'"; } $where .= " AND ac.transdate >= '$fromdate'"; } @@ -653,6 +653,7 @@ sub get_accounts_ustva { $where .= " AND ac.transdate <= '$todate'"; $ARwhere .= " AND acc.transdate <= '$todate'"; $subwhere .= " AND transdate <= '$todate'"; + $APwhere .= " AND AP.transdate <= '$todate'"; } if ($department_id) { @@ -669,13 +670,18 @@ sub get_accounts_ustva { AND ac.project_id = $form->{project_id} |; } +######################################### +# Method eq 'cash' = IST Versteuerung +######################################### - if ($form->{method} eq 'cash') { + if ($form->{method} eq 'cash') { $query = qq| - SELECT - SUM( ac.amount * + -- Alle tatsaechlichen Zahlungseingaenge + -- im Voranmeldezeitraum erfassen + -- (Teilzahlungen werden prozentual auf verschiedene Steuern aufgeteilt) + SUM( ac.amount * -- Bezahlt / Rechnungssumme ( SELECT SUM(acc.amount) @@ -700,101 +706,44 @@ sub get_accounts_ustva { -- Here no where, please. All Transactions ever should be -- testet if they are paied in the USTVA report period. GROUP BY c.pos_ustva - UNION - - SELECT sum(ac.amount) AS amount, - c.$category - FROM acc_trans ac - JOIN chart c ON (c.id = ac.chart_id) - JOIN ap a ON (a.id = ac.trans_id) - $dpt_join - WHERE $where - $dpt_where - AND ac.trans_id IN - ( - SELECT trans_id - FROM acc_trans - JOIN chart ON (chart_id = id) - WHERE link LIKE '%AP_amount%' - $subwhere - ) - - $project - GROUP BY c.$category - - UNION - - SELECT sum(ac.amount) AS amount, - c.$category - FROM acc_trans ac - JOIN chart c ON (c.id = ac.chart_id) - JOIN gl a ON (a.id = ac.trans_id) - $dpt_join - WHERE $where - $glwhere - $dpt_from - AND NOT (c.link = 'AR' OR c.link = 'AP') - $project - GROUP BY c.$category - - |; - if ($form->{project_id}) { - - $query .= qq| - - UNION - - SELECT SUM(ac.sellprice * ac.qty) AS amount, - c.$category - FROM invoice ac - JOIN ar a ON (a.id = ac.trans_id) - JOIN parts p ON (ac.parts_id = p.id) - JOIN chart c on (p.income_accno_id = c.id) - $dpt_join - -- use transdate from subwhere - WHERE 1 = 1 $subwhere - AND c.category = 'I' - $dpt_where - AND ac.trans_id IN - ( - SELECT trans_id - FROM acc_trans - JOIN chart ON (chart_id = id) - WHERE link LIKE '%AR_paid%' - $subwhere - ) - - $project - GROUP BY c.$category - - UNION - - SELECT SUM(ac.sellprice) AS amount, - c.$category - FROM invoice ac - JOIN ap a ON (a.id = ac.trans_id) - JOIN parts p ON (ac.parts_id = p.id) - JOIN chart c on (p.expense_accno_id = c.id) - $dpt_join - WHERE 1 = 1 $subwhere - AND c.category = 'E' - $dpt_where - AND ac.trans_id IN - ( - SELECT trans_id - FROM acc_trans - JOIN chart ON (chart_id = id) - WHERE link LIKE '%AP_paid%' - $subwhere - ) - - $project - GROUP BY c.$category - |; - } - - } else { + UNION -- alle Ausgaben AP erfassen + + SELECT + sum(ac.amount) AS amount, pos_ustva + FROM acc_trans ac + JOIN AP ON (AP.id = ac.trans_id ) + JOIN chart c ON (c.id = ac.chart_id AND pos_ustva NOT LIKE '') + WHERE + 1=1 + $APwhere + $dpt_where + $project + GROUP BY pos_ustva + + UNION -- alle Ausgaben und Einnahmen direkter gl Buchungen erfassen + + SELECT sum + ( + CASE WHEN c.link LIKE '%AR%' THEN ac.amount * -1 + WHEN c.link LIKE '%AP%' THEN ac.amount * 1 + END + ) AS amount, c.$category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gl a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $dpt_from + AND NOT (c.link = 'AR' OR c.link = 'AP') + $project + GROUP BY c.$category + |; + + } else { +######################################### +# Method eq 'accrual' = Soll Versteuerung +######################################### if ($department_id) { $dpt_join = qq| @@ -806,69 +755,38 @@ sub get_accounts_ustva { } $query = qq| - - SELECT sum(ac.amount) AS amount, - c.$category - FROM acc_trans ac - JOIN chart c ON (c.id = ac.chart_id) - $dpt_join - WHERE $where - $dpt_where - $project - GROUP BY c.$category - |; - - if ($form->{project_id}) { - - $query .= qq| - - UNION - - SELECT SUM(ac.sellprice * ac.qty) AS amount, - c.$category - FROM invoice ac - JOIN ar a ON (a.id = ac.trans_id) - JOIN parts p ON (ac.parts_id = p.id) - JOIN chart c on (p.income_accno_id = c.id) - $dpt_join - -- use transdate from subwhere - WHERE 1 = 1 $subwhere - AND c.category = 'I' - $dpt_where - $project - GROUP BY c.$category - - UNION - - SELECT SUM(ac.sellprice * ac.qty) * -1 AS amount, - c.$category - FROM invoice ac - JOIN ap a ON (a.id = ac.trans_id) - JOIN parts p ON (ac.parts_id = p.id) - JOIN chart c on (p.expense_accno_id = c.id) - $dpt_join - WHERE 1 = 1 $subwhere - AND c.category = 'E' - $dpt_where - $project - GROUP BY c.$category - |; - - } + SELECT sum + ( + CASE WHEN c.link LIKE '%AR%' THEN ac.amount * -1 + WHEN c.link LIKE '%AP%' THEN ac.amount * 1 + END + ) AS amount, c.$category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + GROUP BY c.$category + |; } my @accno; my $accno; my $ref; - #print $query; + # Show all $query in Debuglevel LXDebug::QUERY + $callingdetails = (caller (0))[3]; + $main::lxdebug->message(LXDebug::QUERY, "$callingdetails \$query=\n $query"); + my $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); while ($ref = $sth->fetchrow_hashref(NAME_lc)) { - if ($ref->{amount} < 0) { +# Bug 365 solved?! +# if ($ref->{amount} < 0) { $ref->{amount} *= -1; - } +# } if ($category eq "pos_bwa") { if ($last_period) { $form->{ $ref->{$category} }{kumm} += $ref->{amount}; diff --git a/SL/User.pm b/SL/User.pm index 39d40c4e3..f331ca4af 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -57,7 +57,7 @@ sub new { # remove any trailing whitespace s/^\s*(.*?)\s*$/$1/; - ($key, $value) = split /=/, $_, 2; + ($key, $value) = split(/=/, $_, 2); if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { $value = "lx-office-erp.css"; @@ -114,8 +114,12 @@ sub login { if ($self->{login}) { if ($self->{password}) { - $form->{password} = crypt $form->{password}, - substr($self->{login}, 0, 2); + if ($form->{hashed_password}) { + $form->{password} = $form->{hashed_password}; + } else { + $form->{password} = crypt($form->{password}, + substr($self->{login}, 0, 2)); + } if ($self->{password} ne $form->{password}) { $main::lxdebug->leave_sub(); return -1; @@ -162,19 +166,27 @@ sub login { $rc = 0; - if ($form->{dbversion} ne $dbversion) { - - # update the tables - open FH, ">$userspath/nologin" or die " -$!"; + if (&update_available($myconfig{"dbdriver"}, $dbversion)) { map { $form->{$_} = $myconfig{$_} } - qw(dbname dbhost dbport dbdriver dbuser dbpasswd); + qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect); + + $form->{"stylesheet"} = "lx-office-erp.css"; + $form->{"title"} = $main::locale->text("Dataset upgrade"); + $form->header(); + print($form->parse_html_template("dbupgrade/header")); $form->{dbupdate} = "db$myconfig{dbname}"; $form->{ $form->{dbupdate} } = 1; - $form->info("Upgrading Dataset $myconfig{dbname} ..."); + if ($form->{"show_dbupdate_warning"}) { + print($form->parse_html_template("dbupgrade/warning")); + exit(0); + } + + # update the tables + open FH, ">$userspath/nologin" or die " +$!"; # required for Oracle $form->{dbdefault} = $sid; @@ -188,7 +200,7 @@ $!"; # remove lock file unlink "$userspath/nologin"; - $form->info("... done"); + print($form->parse_html_template("dbupgrade/footer")); $rc = -2; @@ -272,7 +284,7 @@ sub dbsources { if ($form->{dbdriver} eq 'Pg') { - $query = qq|SELECT datname FROM pg_database|; + $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|; $sth = $dbh->prepare($query); $sth->execute || $form->dberror($query); @@ -380,20 +392,68 @@ sub dbcreate { $filename = qq|sql/$form->{chart}-chart.sql|; $self->process_query($form, $dbh, $filename); - # create indices - # Indices sind auch in lx-office.sql - # $filename = qq|sql/$form->{dbdriver}-indices.sql|; - # $self->process_query($form, $dbh, $filename); + $query = "UPDATE defaults SET coa = " . $dbh->quote($form->{"chart"}); + $dbh->do($query) || $form->dberror($query); $dbh->disconnect; $main::lxdebug->leave_sub(); } +# Process a Perl script which updates the database. +# If the script returns 1 then the update was successful. +# Return code "2" means "needs more interaction; remove +# users/nologin and exit". +# All other return codes are fatal errors. +sub process_perl_script { + $main::lxdebug->enter_sub(); + + my ($self, $form, $dbh, $filename, $version) = @_; + + open(FH, "$filename") or $form->error("$filename : $!\n"); + my $contents = join("", ); + close(FH); + + $dbh->begin_work(); + + my %dbup_myconfig = (); + map({ $dbup_myconfig{$_} = $form->{$_}; } + qw(dbname dbuser dbpasswd dbhost dbport dbconnect)); + + my $nls_file = $filename; + $nls_file =~ s|.*/||; + $nls_file =~ s|.pl$||; + my $dbup_locale = Locale->new($main::language, $nls_file); + + my $result = eval($contents); + + if (1 != $result) { + $dbh->rollback(); + $dbh->disconnect(); + } + + if (!defined($result)) { + print($form->parse_html_template("dbupgrade/error", + { "file" => $filename, + "error" => $@ })); + exit(0); + } elsif (1 != $result) { + unlink("users/nologin") if (2 == $result); + exit(0); + } + + if ($version) { + $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version)); + } + $dbh->commit(); + + $main::lxdebug->leave_sub(); +} + sub process_query { $main::lxdebug->enter_sub(); - my ($self, $form, $dbh, $filename) = @_; + my ($self, $form, $dbh, $filename, $version) = @_; # return unless (-f $filename); @@ -402,13 +462,15 @@ sub process_query { my $sth; my @quote_chars; + $dbh->begin_work(); + while () { # Remove DOS and Unix style line endings. - s/[\r\n]//g; + chomp; - # don't add comments or empty lines - next if /^(--.*|\s+)$/; + # remove comments + s/--.*$//; for (my $i = 0; $i < length($_); $i++) { my $char = substr($_, $i, 1); @@ -429,8 +491,15 @@ sub process_query { # Query is complete. Send it. $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - $sth->finish; + if (!$sth->execute()) { + my $errstr = $dbh->errstr; + $sth->finish(); + $dbh->rollback(); + $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:
${query}
" . + "The error message was: ${errstr}
" . + "All changes in that file have been reverted."); + } + $sth->finish(); $char = ""; $query = ""; @@ -441,6 +510,11 @@ sub process_query { } } + if ($version) { + $dbh->do("UPDATE defaults SET version = " . $dbh->quote($version)); + } + $dbh->commit(); + close FH; $main::lxdebug->leave_sub(); @@ -482,7 +556,7 @@ sub dbsources_unused { while () { if (/^dbname=/) { - my ($null, $item) = split /=/; + my ($null, $item) = split(/=/); push @dbexcl, $item; } } @@ -598,7 +672,7 @@ sub dbneedsupdate { ## LINET sub calc_version { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my (@v, $version, $i); @@ -612,7 +686,7 @@ sub calc_version { $version += $v[$i]; } - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $version; } @@ -640,6 +714,17 @@ sub cmp_script_version { } ## /LINET +sub update_available { + my ($dbdriver, $cur_version) = @_; + + opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!"); + my @upgradescripts = + grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)/, readdir(SQLDIR)); + closedir SQLDIR; + + return ($#upgradescripts > -1); +} + sub dbupdate { $main::lxdebug->enter_sub(); @@ -654,11 +739,11 @@ sub dbupdate { if ($form->{dbupdate}) { # read update scripts into memory - opendir SQLDIR, "sql/." or &error("", "$!"); + opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!"); ## LINET @upgradescripts = sort(cmp_script_version - grep(/$form->{dbdriver}-upgrade-.*?\.sql$/, readdir(SQLDIR))); + grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR))); ## /LINET closedir SQLDIR; } @@ -693,9 +778,11 @@ sub dbupdate { foreach my $upgradescript (@upgradescripts) { my $a = $upgradescript; - $a =~ s/^$form->{dbdriver}-upgrade-|\.sql$//g; + $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g; + my $file_type = $1; my ($mindb, $maxdb) = split /-/, $a; + my $str_maxdb = $maxdb; ## LINET $mindb = calc_version($mindb); $maxdb = calc_version($maxdb); @@ -707,7 +794,12 @@ sub dbupdate { last if ($version < $mindb); # apply upgrade - $self->process_query($form, $dbh, "sql/$upgradescript"); + $main::lxdebug->message(DEBUG2, "Appliying Update $upgradescript"); + if ($file_type eq "sql") { + $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); + } else { + $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); + } $version = $maxdb; diff --git a/VERSION b/VERSION index b1b25a5ff..197c4d5c2 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -2.2.2 +2.4.0 diff --git a/bin/lynx/menu.pl b/bin/lynx/menu.pl deleted file mode 100644 index 655fc2333..000000000 --- a/bin/lynx/menu.pl +++ /dev/null @@ -1,155 +0,0 @@ -###################################################################### -# SQL-Ledger Accounting -# Copyright (c) 2001 -# -# Author: Dieter Simader -# Email: dsimader@sql-ledger.org -# Web: http://www.sql-ledger.org -# -# Contributors: Christopher Browne -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -####################################################################### -# -# menu for text based browsers (lynx) -# -# CHANGE LOG: -# DS. 2000-07-04 Created -# DS. 2001-08-07 access control -# CBB 2002-02-09 Refactored HTML out to subroutines -####################################################################### - -$menufile = "menu.ini"; -use SL::Menu; - - -1; -# end of main - - - -sub display { - - $menu = new Menu "$menufile"; - $menu = new Menu "custom_$menufile" if (-f "custom_$menufile"); - $menu = new Menu "$form->{login}_$menufile" if (-f "$form->{login}_$menufile"); - - @menuorder = $menu->access_control(\%myconfig); - - $form->{title} = "SQL-Ledger $form->{version}"; - - $form->header; - - $offset = int (21 - $#menuorder)/2; - - print "

";
-  print "\n" x $offset;
-  print "

"; - - print qq||; - - map { print "|; } @menuorder; - - print qq' -

".$menu->menuitem(\%myconfig, \%$form, $_).$locale->text($_).qq|

- - - -'; - - # display the company logo -# $argv = "login=$form->{login}&password=$form->{password}&path=$form->{path}&action=company_logo&noheader=1"; -# exec "./login.pl", $argv; - -} - - -sub section_menu { - - $menu = new Menu "$menufile", $form->{level}; - - # build tiered menus - @menuorder = $menu->access_control(\%myconfig, $form->{level}); - - foreach $item (@menuorder) { - $a = $item; - $item =~ s/^$form->{level}--//; - push @neworder, $a unless ($item =~ /--/); - } - @menuorder = @neworder; - - $level = $form->{level}; - $level =~ s/--/ /g; - - $form->{title} = $locale->text($level); - - $form->header; - - $offset = int (21 - $#menuorder)/2; - print "

";
-  print "\n" x $offset;
-  print "

"; - - print qq||; - - foreach $item (@menuorder) { - $label = $item; - $label =~ s/$form->{level}--//g; - - # remove target - $menu->{$item}{target} = ""; - - print ""; - } - - print qq'

".$menu->menuitem(\%myconfig, \%$form, $item, $form->{level}).$locale->text($label)."

- - - -'; - -} - - -sub acc_menu { - - §ion_menu; - -} - - -sub menubar { - $menu = new Menu "$menufile", ""; - - # build menubar - @menuorder = $menu->access_control(\%myconfig, ""); - - @neworder = (); - map { push @neworder, $_ unless ($_ =~ /--/) } @menuorder; - @menuorder = @neworder; - - print "

"; - $form->{script} = "menu.pl"; - - foreach $item (@menuorder) { - $label = $item; - - # remove target - $menu->{$item}{target} = ""; - - print $menu->menuitem(\%myconfig, \%$form, $item, "").$locale->text($label)." | "; - } - -} - diff --git a/bin/mozilla/admin.pl b/bin/mozilla/admin.pl index e55c99984..b2f7576af 100644 --- a/bin/mozilla/admin.pl +++ b/bin/mozilla/admin.pl @@ -38,6 +38,7 @@ use SL::Form; use SL::User; $form = new Form; +$form->{"root"} = "root login"; $locale = new Locale $language, "admin"; @@ -55,6 +56,7 @@ $form->{favicon} = "favicon.ico"; if ($form->{action}) { + $subroutine = $locale->findsub($form->{action}); if ($subroutine eq 'login') { @@ -123,7 +125,6 @@ sub adminlogin { . $locale->text('Login') . qq|"> - {path}> @@ -163,6 +164,10 @@ sub add_user { } $myconfig->{vclimit} = 200; + $myconfig->{"countrycode"} = "de"; + $myconfig->{"numberformat"} = "1000,00"; + $myconfig->{"dateformat"} = "dd.mm.yy"; + &form_header; &form_footer; @@ -192,8 +197,7 @@ sub form_footer { print qq| - - + {path}> {rpw}> @@ -235,7 +239,7 @@ sub list_users { if (/^(name=|company=|templates=|dbuser=|dbdriver=|dbname=|dbhost=)/) { chop($var = $&); - ($null, $member{$login}{$var}) = split /=/, $_, 2; + ($null, $member{$login}{$var}) = split(/=/, $_, 2); } } @@ -289,7 +293,7 @@ sub list_users { foreach $key (sort keys %member) { $href = - "$script?action=edit&login=$key&path=$form->{path}&root=$form->{root}&rpw=$form->{rpw}"; + "$script?action=edit&login=$key&path=$form->{path}&rpw=$form->{rpw}"; $href =~ s/ /%20/g; $member{$key}{templates} =~ s/^$templates\///; @@ -298,7 +302,7 @@ sub list_users { $member{$key}{dbname} = $member{$key}{dbuser} if ($member{$key}{dbdriver} eq 'Oracle'); - $column_data{login} = qq|$key|; + $column_data{login} = qq|$key|; $column_data{name} = qq|$member{$key}{name}|; $column_data{company} = qq|$member{$key}{company}|; $column_data{dbdriver} = qq|$member{$key}{dbdriver}|; @@ -309,7 +313,7 @@ sub list_users { $i++; $i %= 2; print qq| - |; + |; map { print "$column_data{$_}\n" } @column_index; @@ -328,7 +332,6 @@ sub list_users { {path}> {rpw}> -
@@ -441,7 +444,8 @@ sub form_header { closedir TEMPLATEDIR; @allhtml = sort grep /\.html/, @all; - @alldir = grep !/\.(html|tex)$/, @all; + @alldir = grep !/\.(html|tex|sty|odt)$/, @all; + @alldir = grep !/^(webpages|\.svn)$/, @alldir; @allhtml = reverse grep !/Default/, @allhtml; push @allhtml, 'Default'; @@ -462,7 +466,8 @@ sub form_header { $item =~ s/-.*//g; if ($item ne $lastitem) { - $mastertemplates .= qq|

{script}> -| - . $locale->text('Password') - . qq| + + + + + + + + + +

\| . $locale->text('Password') . qq\|
\| . $locale->text('Repeat the password') . qq\|

- {path}> {rpw}> @@ -1136,6 +1148,24 @@ sub change_admin_password { } sub change_password { + if ($form->{"password"} ne $form->{"password_again"}) { + $form->{title} = + qq|Lx-Office ERP | + . $locale->text('Administration') . " / " + . $locale->text('Change Admin Password'); + + $form->header; + + print qq| + + + +

| . $locale->text('Change Admin Password') . qq|

+ +

| . $locale->text("The passwords do not match.") . qq|
+|; + return; + } $root->{password} = $form->{password}; @@ -1143,20 +1173,17 @@ sub change_password { $root->save_member($memberfile); $form->{callback} = - "$form->{script}?action=list_users&path=$form->{path}&root=$form->{root}&rpw=$root->{password}"; + "$form->{script}?action=list_users&path=$form->{path}&rpw=$root->{password}"; $form->redirect($locale->text('Password changed!')); } sub check_password { - $root = new User "$memberfile", $form->{root}; - if ($root->{password}) { - if ($root->{password} ne $form->{rpw}) { - $form->error($locale->text('Incorrect Password!')); - } + if (!defined($root->{password}) || ($root->{password} ne $form->{rpw})) { + $form->error($locale->text('Incorrect Password!')); } } @@ -1267,18 +1294,18 @@ sub dbselect_source { - - + {path}> {rpw}>
- -|; +# Vorübergehend Deaktiviert +# +print qq|

@@ -1325,11 +1352,12 @@ sub update_dataset {

$form->{title}

|; - + my $field_id = 0; foreach $key (sort keys %needsupdate) { if ($needsupdate{$key} ne $form->{dbversion}) { - $upd .= qq| $key\n|; + $upd .= qq| $key\n|; $form->{dbupdate} .= "db$key "; + $field_id++; } } @@ -1363,9 +1391,8 @@ $upd - + - {path}> {rpw}> @@ -1397,10 +1424,29 @@ $upd } sub dbupdate { + $form->{"stylesheet"} = "lx-office-erp.css"; + $form->{"title"} = $main::locale->text("Dataset upgrade"); + $form->header(); + my $dbname = + join(" ", + map({ s/\s//g; s/^db//; $_; } + grep({ $form->{$_} } + split(/\s+/, $form->{"dbupdate"})))); + print($form->parse_html_template("dbupgrade/header", + { "dbname" => $dbname })); User->dbupdate(\%$form); - $form->redirect($locale->text('Dataset updated!')); + print qq| +

+ +| . $locale->text('Dataset updated!') . qq| + +
+ +| . $locale->text("Continue") . qq||; } @@ -1496,9 +1542,8 @@ sub create_dataset { {dbpasswd}> {dbdefault}> - + - {path}> {rpw}> @@ -1550,7 +1595,6 @@ sub dbcreate { . qq| - @@ -1614,9 +1658,8 @@ sub delete_dataset { {dbpasswd}> {dbdefault}> - + - @@ -1667,7 +1710,6 @@ $form->{db} | . $locale->text('successfully deleted!') . qq| - @@ -1689,7 +1731,7 @@ sub unlock_system { unlink "$userspath/nologin"; $form->{callback} = - "$form->{script}?action=list_users&path=$form->{path}&root=$form->{root}&rpw=$root->{password}"; + "$form->{script}?action=list_users&path=$form->{path}&rpw=$root->{password}"; $form->redirect($locale->text('Lockfile removed!')); @@ -1702,7 +1744,7 @@ sub lock_system { close(FH); $form->{callback} = - "$form->{script}?action=list_users&path=$form->{path}&root=$form->{root}&rpw=$root->{password}"; + "$form->{script}?action=list_users&path=$form->{path}&rpw=$root->{password}"; $form->redirect($locale->text('Lockfile created!')); diff --git a/bin/mozilla/am.pl b/bin/mozilla/am.pl index e0ae42f7a..1ebd59816 100644 --- a/bin/mozilla/am.pl +++ b/bin/mozilla/am.pl @@ -36,8 +36,12 @@ use SL::CA; use SL::Form; use SL::User; +use Data::Dumper; + 1; +require "$form->{path}/common.pl"; + # end of main sub add { &{"add_$form->{type}"} } @@ -90,14 +94,13 @@ sub account_header { $form->{description} =~ s/\"/"/g; if (@{ $form->{TAXKEY} }) { - $form->{selecttaxkey} = ""; + } + foreach $item (@{ $form->{NEWACCOUNT} }) { + if ($item->{id} == $form->{new_chart_id}) { + $form->{selectnewaccount} .= + ""; + } elsif (!$form->{new_chart_valid}) { + $form->{selectnewaccount} .= + ""; + } + + } + } + + $newaccount = qq| + + + + + + + + + +

\| . $locale->text('Folgekonto') . qq\|		\| . $locale->text('Gültig ab') . qq\|

+ |; $form->{selectustva} = "\n" + } (@{ $form->{DUNNING} }); + } + $dunning_level = qq| + + | . $locale->text('Next Dunning Level') . qq| + + + | if $form->{selectdunning_level}; + + # departments + if (@{ $form->{all_departments} }) { + $form->{selectdepartment} = ""; + } + } + + + $form->{nextsub} = "save_dunning"; + + $form->{callback} = + "$form->{script}?action=show_invoices&path=$form->{path}&login=$form->{login}&password=$form->{password}&customer=$form->{customer}&invnumber=$form->{invnumber}&ordnumber=$form->{ordnumber}&paymentuntil=$form->{paymentuntil}&groupinvoices=$form->{groupinvoices}&minamount=$form->{minamount}&dunning_level=$form->{dunning_level}¬es=$form->{notes}" + unless $form->{callback}; + + @column_index = qw(dunning_description active email customername invnumber invdate inv_duedate invamount next_duedate fee interest ); + + $column_header{dunning_description} = + qq|| + . $locale->text('Current / Next Level') + . qq||; + $column_header{active} = + qq|| + . $locale->text('Active?') + . qq||; + $column_header{email} = + qq|| + . $locale->text('eMail?') + . qq||; + $column_header{customername} = + qq|| + . $locale->text('Customername') + . qq||; + $column_header{invnumber} = + qq|| + . $locale->text('Invno.') + . qq||; + $column_header{inv_duedate} = + qq|| + . $locale->text('Inv. Duedate') + . qq||; + $column_header{next_duedate} = + qq|| + . $locale->text('Dunning Duedate') + . qq||; + $column_header{invdate} = + qq|| + . $locale->text('Invdate') + . qq||; + $column_header{invamount} = + qq|| + . $locale->text('Amount') + . qq||; + $column_header{fee} = + qq|| + . $locale->text('Total Fees') + . qq||; + $column_header{interest} = + qq|| + . $locale->text('Total Interest') + . qq||; + + $form->header; + + + print qq| + + + +

{script}> + + + + + + + + |; + map { print "$column_header{$_}\n" } @column_index; + + print qq| + +|; + my $i = 0; + foreach $ref (@{ $form->{DUNNINGS} }) { + + $i++; + my $j = $i % 2; + + print qq| + +|; + + $form->{selectdunning} =~ s/ selected//g; + if ($ref->{next_dunning_id} ne "") { + $form->{selectdunning} =~ s/value=$ref->{next_dunning_id}/value=$ref->{next_dunning_id} selected/; + } + + + $dunning = qq||; + + + $column_data{dunning_description} = qq||; + my $active = "checked"; + $column_data{active} = + qq||; + my $email = "checked"; + $column_data{email} = + qq||; + $column_data{next_duedate} = qq||; + + $column_data{inv_duedate} = qq||; + $column_data{invdate} = qq||; + $column_data{invnumber} = qq||; + $column_data{customername} = qq||; + $column_data{invamount} = qq||; + $column_data{fee} = qq||; + $column_data{interest} = qq||; + + + + map { print "$column_data{$_}\n" } @column_index; + + print qq| + +|; + } + + $form->{rowcount} = $i; + + print qq| +

$form->{title}
$ref->{dunning_level}: $dunning			$ref->{next_duedate}	$ref->{duedate}	$ref->{transdate}	$ref->{invnumber}	$ref->{customername}	$ref->{amount}	$ref->{fee}	$ref->{interest}

+ + + +

+ +|; +&print_options; +print qq| +
+{script}> + + + + + + + +{path}> +{login}> +{password}>|; +#print qq| +# |; +print qq| + +|; + if ($form->{menubar}) { + require "$form->{path}/menu.pl"; + &menubar; + } + + print qq| + +

+ + + +|; + + + $lxdebug->leave_sub(); + +} + +sub save { + $lxdebug->enter_sub(); + + for my $i (1 .. $form->{rowcount}) { + if ($form->{"dunning_description_$i"} ne "") { + $form->isblank("dunning_level_$i", $locale->text('Dunning Level missing in row '). $i); + $form->isblank("dunning_description_$i", $locale->text('Dunning Description missing in row '). $i); + $form->isblank("terms_$i", $locale->text('Terms missing in row '). $i); + $form->isblank("payment_terms_$i", $locale->text('Payment Terms missing in row '). $i); + } + } + + DN->save_config(\%myconfig, \%$form); + $form->redirect($locale->text('Dunning Process Config saved!')); + + $lxdebug->leave_sub(); +} + +sub save_dunning { + $lxdebug->enter_sub(); + + my $active=1; + my @rows = (); + undef($form->{DUNNING_PDFS}); + if ($form->{groupinvoices}) { + while ($active) { + $lastcustomer = 0; + $form->{inv_ids} = ""; + $active = 0; + @rows = (); + for my $i (1 .. $form->{rowcount}) { + $form->{"active_$i"} *= 1; + $lastcustomer = $form->{"customer_id_$i"} unless ($lastcustomer); + if ($form->{"active_$i"} && ($form->{"customer_id_$i"} == $lastcustomer)) { + if ($form->{inv_ids}) { + $form->{inv_ids} .= qq|,$form->{"inv_id_$i"}|; + } else { + $form->{inv_ids} = qq|($form->{"inv_id_$i"}|; + } + $form->{"active_$i"} = 0; + $form->{"customer_id_$i"} = 0; + push(@rows, $i); + } elsif ($form->{"active_$i"}) { + $active = 1; + } else { + $form->{"customer_id_$i"} = 0; + } + } + if ($form->{inv_ids} ne "") { + $form->{inv_ids} .= ")"; + DN->save_dunning(\%myconfig, \%$form, \@rows, $userspath,$spool, $sendmail); + } + } + } else { + for my $i (1 .. $form->{rowcount}) { + if ($form->{"active_$i"}) { + @rows = (); + $form->{inv_ids} = qq|($form->{"inv_id_$i"})|; + push(@rows, $i); + DN->save_dunning(\%myconfig, \%$form, \@rows, $userspath,$spool, $sendmail); + } + } + } + if($form->{DUNNING_PDFS}) { + DN->melt_pdfs(\%myconfig, \%$form,$spool); + } + + $form->redirect($locale->text('Dunning Process started for selected invoices!')); + + $lxdebug->leave_sub(); +} + +sub set_email { + $lxdebug->enter_sub(); + + + my $callback = "$form->{script}?action=set_email&"; + map({ $callback .= "$_=" . $form->escape($form->{$_}) . "&" } + (qw(login path password name input_subject input_body input_attachment email_subject email_body email_attachment), grep({ /^[fl]_/ } keys %$form))); + + if ($form->{email_attachment}) { + $form->{email_attachment} = "checked"; + } + $form->{"title"} = $locale->text("Set eMail text"); + $form->header(); + print($form->parse_html_template("dunning/set_email")); + + $lxdebug->leave_sub(); +} + +sub search { + $lxdebug->enter_sub(); + # setup customer selection + $form->all_vc(\%myconfig, "customer", "AR"); + + DN->get_config(\%myconfig, \%$form); + + if (@{ $form->{all_customer} }) { + map { $customer .= "\n" + } (@{ $form->{DUNNING} }); + } + $dunning_level = qq| + + | . $locale->text('Next Dunning Level') . qq| + + + | if $form->{selectdunning_level}; + + # departments + if (@{ $form->{all_departments} }) { + $form->{selectdepartment} = "" + "" } @{ $form->{chart} }; map { $tax .= - qq|" + "" } @{ $form->{chart} }; map { $tax .= - qq|

\| . $locale->text('Code') . qq\|	{code}>
\| . $locale->text('Language') . qq\|
	\| - . $locale->text('Heading') . qq\|
\| . $locale->text('Template Code') . qq\|	{template_code}>
\| . $locale->text('Description') . qq\|		\| . $locale->text('Article Code') . qq\|	{article_code}>

$form->{title}
\| . $locale->text('Printer') . qq\|
\| . $locale->text('Printer Command') . qq\|
\| . $locale->text('Template Code') . qq\|

$form->{title}
\| . $locale->text('Description') . qq\|
\| . $locale->text('Long Description') . qq\|
\| . $locale->text('Netto Terms') . qq\|
\| . $locale->text('Skonto Terms') . qq\|
\| . $locale->text('Skonto') . qq\| %

$form->{title}
\| . $locale->text('Code') . qq\|	{code}>
	\| + . $locale->text('Heading') . qq\|
\| . $locale->text('Description') . qq\|

Dateiname	Webdavlink
$file	$form->{WEBDAV}{$file}

\| + . $locale->text('Incoming Payments') . qq\|
" . $locale->text('Date') . "	" . $locale->text('Amount') . "	" . $locale->text('Exch') . "	" . $locale->text('Account') . "	" . $locale->text('Source') . "	" . $locale->text('Memo') . "
{"paid_$i"}>	$exchangerate		{"datepaid_$i"}>

\| . $locale->text('Credit Limit') . qq\|			\| . $locale->text('Terms: Net') . qq\|	\| +	\| . $locale->text('days') . qq\|	\| . $locale->text('Discount') . qq\|	+	%
\| . $locale->text('Tax Number / SSN') . qq\|			\| . $locale->text('USt-IdNr.') . qq\|
\| . $locale->text('Account Number') . qq\|			\| . $locale->text('Bank Code Number') . qq\|			\| . $locale->text('Bank') . qq\|
\| . $locale->text('Language') . qq\|
\| . $locale->text('Obsolete') . qq\|	{obsolete}>	\| . $locale->text('Payment Terms') . qq\|

\| . $locale->text('Company Name') . qq\|
\| . $locale->text('Abteilung') . qq\|	+
\| . $locale->text('Street') . qq\|
\| + . $locale->text('Zipcode') . "/" . $locale->text('City') . qq\|	+
\| . $locale->text('Country') . qq\|
\| . $locale->text('Contact') . qq\|
\| . $locale->text('Phone') . qq\|
\| . $locale->text('Fax') . qq\|
\| . $locale->text('E-mail') . qq\|

\| . $locale->text('From') . qq\|		\| . $locale->text('Bis') . qq\|
+ + +

\| . $locale->text('Credit Note Date') . qq\|

\| . $locale->text('Credit Note Number') . qq\|
\| . $locale->text('Invoice Number') . qq\|
\| . $locale->text('Delivery Date') . qq\|
\| . $locale->text('Order Number') . qq\|
\| . $locale->text('Notes') . qq\|	\| . $locale->text('Internal Notes') . qq\|	\| . $locale->text('Payment Terms') . qq\|
$notes	$intnotes

Variablenname	Bedeutung
`account_number`	Kontonummer
`bank`	Name der Bank
`bank_code`	Bankleitzahl
`business`	Kundentyp
`city`	Stadt
`contact`	Kontakt
`country`	Land
`cp_email`	Email des Ansprechpartners
`cp_givenname`	Vorname des Ansprechpartners
`cp_greeting`	Anrede des Ansprechpartners
`cp_name`	Name des Ansprechpartners
`cp_phone1`	Telefonnummer 1 des Ansprechpartners
`cp_phone2`	Telefonnummer 2 des Ansprechpartners
`cp_title`	Titel des Ansprechpartners
`creditlimit`	Kreditlimit
`customernumber`	Kundennummer; nur für Kunden
`customernotes`	Bemerkungen beim Kunden; nur für Kunden
`discount`	Rabatt
`email`	Emailadresse
`fax`	Faxnummer
`homepage`	Homepage
`language`	Sprache
`name`	Firmenname
`phone`	Telefonnummer
`shiptocity`	Stadt (Lieferadresse) + *
`shiptocontact`	Kontakt (Lieferadresse) + *
`shiptocountry`	Land (Lieferadresse) + *
`shiptoemail`	Email (Lieferadresse) + *
`shiptofax`	Fax (Lieferadresse) + *
`shiptoname`	Firmenname (Lieferadresse) + *
`shiptophone`	Telefonnummer (Lieferadresse) + *
`shiptostreet`	Straße und Hausnummer (Lieferadresse) + *
`shiptozipcode`	Postleitzahl (Lieferadresse) + *
`street`	Straße und Hausnummer
`taxnumber`	Steuernummer
`terms`	Zahlungsziel
`vendoremail`	Email des Lieferanten; nur für Lieferanten
`vendorfax`	Faxnummer des Lieferanten; nur für Lieferanten
`vendornotes`	Bemerkungen beim Lieferanten; nur für Lieferanten
`vendornumber`	Lieferantennummer; nur für Lieferanten
`vendorphone`	Telefonnummer des Lieferanten; nur für Lieferanten
`zipcode`	Postleitzahl

Variablenname	Bedeutung
`employee_email`	Email
`employee_fax`	Fax
`employee_name`	voller Name
`employee_signature`	Signatur
`employee_tel`	Telefonnummer

Variablenname	Bedeutung
`tax`	Steuer
`taxbase`	zu versteuernder Betrag
`taxdescription`	Name der Steuer
`taxrate`	Steuersatz

Variablenname	Bedeutung
`creditremaining`	Verbleibender Kredit
`currency`	Währung
`cusordnumber`	Bestellnummer beim Kunden
`deliverydate`	Lieferdatum
`duedate`	Fälligkeitsdatum
`intnotes`	Interne Bemerkungen
`invdate`	Rechnungsdatum
`invnumber`	Rechnungsnummer
`invtotal`	gesamter Rechnungsbetrag
`notes`	Bemerkungen der Rechnung
`ordnumber`	Auftragsnummer, wenn die Rechnung aus einem Auftrag erstellt wurde
`quonumber`	Angebotsnummer
`shippingpoint`	Versandort
`shipvia`	Transportmittel
`subtotal`	Zwischensumme aller Posten ohne Steuern
`sumcarriedforward`	Zwischensumme aller bisher ausgegebenen Posten. Sollte nur in einem + + `pagebreak`-Block verwendet werden.
`total`	Restsumme der Rechnung (Summe abzüglich bereits bezahlter Posten)
`transdate`	Auftragsdatum wenn die Rechnung aus einem Auftrag erstellt wurde

Variablenname	Bedeutung
`assembly`	Erzeugnis
`bin`	Stellage
`deliverydate_oe`	Lieferdatum
`description`	Artikelbeschreibung
`discount`	Rabatt als Betrag
`linetotal`	Zeilensumme (Anzahl * Einzelpreis)
`listprice`	Listenpreis
`netprice`	Nettopreis
`number`	Artikelnummer
`ordnumber_oe`	Auftragsnummer des Originalauftrags, wenn die Rechnung aus einem Sammelauftrag erstellt wurde
`p_discount`	Rabatt in Prozent
`partnotes`	Die beim Artikel gespeicherten Bemerkungen
`partsgroup`	Warengruppe
`projectnumber`	Projektnummer
`qty`	Anzahl
`runningnumber`	Position auf der Rechnung (1, 2, 3...)
`sellprice`	Verkaufspreis
`serialnumber`	Seriennummer
`transdate_oe`	Auftragsdatum des Originalauftrags, wenn die Rechnung aus einem Sammelauftrag erstellt wurde
`unit`	Einheit

Variablenname	Bedeutung
`datepaid`	Datum
`memo`	Memo
`paid`	Betrag
`source`	Beleg
`exchangerate`	Wechselkurs
`forex`	Konto

Formatierung	Auswirkung
`<b>Text</b>`	Text wird in fettdruck gesetzt.
`<i>Text</i>`	Text wird kursiv gesetzt.
`<u>Text</u>`	Text wird unterstrichen.
`<s>Text</s>`	Text wird ~~durchgestrichen~~. Diese Formatierung ist nicht bei der + Ausgabe als PDF über LaTeX verfügbar.
`<pagebreak>`	Erzwingt einen Seitenumbruch (siehe unten).

".str_replace(",","	",substr($keys,1,-1))."
",substr($vals,9,-1)); + echo "
".str_replace("null,","null	",$vals)."
",substr($vals,9,-1)); + echo "
".str_replace("null,","null	",$vals)."

Beschreibung:
Inventar:	+ + -- +
Erlöskonto Inand:	+ + -- +
Aufwandskonto EU mit UstId-Nummer:	+ +
Erlöskonto EU mit UstId-Nummer:	+ +
Aufwandskonto EU mit UstId-Nummer:	+ +
Erlöskonto EU ohne UstId-Nummer:	+ +
Aufwandskonto EU ohne UstId-Nummer:	+ +
Erlöskonto Ausland:	+ +
Aufwandskonto Ausland:	+ +

Description:
Inventory:	+ + -- +
Income accno National:	+ + -- +
Expense accno EU with VAT ID:	+ +
Income accno EU with VAT ID:	+ +
Expense accno EU with VAT ID:	+ +
Income accno EU without VAT ID:	+ +
Expense accno EU without VAT ID:	+ +
Income accno International:	+ +
Expense accno International:	+ +


Betreff:	+
Text:	+<TMPL_VAR NAME=email_body ESCAPE=HTML> + +
PDF anhängen	"> +


Subject:	+
Body:	+<TMPL_VAR NAME=email_body ESCAPE=HTML> + +
Attach PDF:	"> +

Error!

| . $locale->text('Change Admin Password') . qq|

$form->{title}

| . $locale->text('Confirm!') . qq|

| + . $locale->text('Are you sure you want to delete Invoice Number') + . qq| $form->{invnumber} +

| . $locale->text('Confirm!') . qq|

| + . $locale->text('Are you sure you want to update the prices') +. qq|

Dokumentenvorlagen und verfügbare Variablen

LaTeX-Vorlagen und verfügbare Variablen