Projekt

Allgemein

Profil

Herunterladen (96,4 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/Form.pm @ bda0d70b

626e0240 Stephan Köhler
#====================================================================
d319704a Moritz Bunkus
# LX-Office ERP
# Copyright (C) 2004
# 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: Thomas Bayen <bayen@gmx.de>
# Antti Kaihola <akaihola@siba.fi>
# Moritz Bunkus (tex code)
#
# 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.
#======================================================================
# Utilities for parsing forms
# and supporting routines for linking account numbers
# used in AR, AP and IS, IR modules
#
#======================================================================

package Form;
b8da8785 Sven Schöling
54e4131e Moritz Bunkus
use Data::Dumper;
d319704a Moritz Bunkus
8c7e4493 Moritz Bunkus
use CGI;
54e4131e Moritz Bunkus
use CGI::Ajax;
8c7e4493 Moritz Bunkus
use Cwd;
753b82ff Moritz Bunkus
use Encode;
eff7e112 Moritz Bunkus
use IO::File;
8c7e4493 Moritz Bunkus
use SL::Auth;
use SL::Auth::DB;
use SL::Auth::LDAP;
use SL::AM;
use SL::Common;
54a4321b Moritz Bunkus
use SL::DBUtils;
2584d83b Moritz Bunkus
use SL::Mailer;
d1c335e9 Moritz Bunkus
use SL::Menu;
8c7e4493 Moritz Bunkus
use SL::Template;
afe8a81b Moritz Bunkus
use SL::User;
8c7e4493 Moritz Bunkus
use Template;
ad9563c8 Moritz Bunkus
use URI;
d707f7ac Moritz Bunkus
use List::Util qw(first max min sum);
22ae0bf0 Sven Schöling
use List::MoreUtils qw(any apply);
99ccfeab Moritz Bunkus
c510d88b Sven Schöling
use strict;

820f3066 Moritz Bunkus
my $standard_dbh;

b2d2a98c Moritz Bunkus
END {
7bd555b6 Moritz Bunkus
disconnect_standard_dbh();
}

sub disconnect_standard_dbh {
return unless $standard_dbh;
$standard_dbh->disconnect();
undef $standard_dbh;
820f3066 Moritz Bunkus
}

e5478aea Moritz Bunkus
sub _store_value {
$main::lxdebug->enter_sub(2);

6737d960 Moritz Bunkus
my $self = shift;
e5478aea Moritz Bunkus
my $key = shift;
my $value = shift;

6737d960 Moritz Bunkus
my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key;
e5478aea Moritz Bunkus
6737d960 Moritz Bunkus
my $curr;
e5478aea Moritz Bunkus
6737d960 Moritz Bunkus
if (scalar @tokens) {
$curr = \ $self->{ shift @tokens };
}
e5478aea Moritz Bunkus
6737d960 Moritz Bunkus
while (@tokens) {
my $sep = shift @tokens;
my $key = shift @tokens;

$curr = \ $$curr->[++$#$$curr], next if $sep eq '[]';
$curr = \ $$curr->[max 0, $#$$curr] if $sep eq '[].';
$curr = \ $$curr->[++$#$$curr] if $sep eq '[+].';
$curr = \ $$curr->{$key}
e5478aea Moritz Bunkus
}

6737d960 Moritz Bunkus
$$curr = $value;
e5478aea Moritz Bunkus
$main::lxdebug->leave_sub(2);

6737d960 Moritz Bunkus
return $curr;
e5478aea Moritz Bunkus
}

d319704a Moritz Bunkus
sub _input_to_hash {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
6737d960 Moritz Bunkus
my $self = shift;
my $input = shift;
e5478aea Moritz Bunkus
6737d960 Moritz Bunkus
my @pairs = split(/&/, $input);
d319704a Moritz Bunkus
foreach (@pairs) {
e5478aea Moritz Bunkus
my ($key, $value) = split(/=/, $_, 2);
6737d960 Moritz Bunkus
$self->_store_value($self->unescape($key), $self->unescape($value)) if ($key);
d319704a Moritz Bunkus
}

8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
}

sub _request_to_hash {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
6737d960 Moritz Bunkus
my $self = shift;
my $input = shift;
68ca5cc3 Moritz Bunkus
if (!$ENV{'CONTENT_TYPE'}
|| ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
e5478aea Moritz Bunkus
6737d960 Moritz Bunkus
$self->_input_to_hash($input);
e5478aea Moritz Bunkus
68ca5cc3 Moritz Bunkus
$main::lxdebug->leave_sub(2);
e5478aea Moritz Bunkus
return;
68ca5cc3 Moritz Bunkus
}

e5478aea Moritz Bunkus
my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
68ca5cc3 Moritz Bunkus
my $boundary = '--' . $1;

foreach my $line (split m/\n/, $input) {
last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));

if (($line eq $boundary) || ($line eq "$boundary\r")) {
e5478aea Moritz Bunkus
${ $previous } =~ s|\r?\n$|| if $previous;
68ca5cc3 Moritz Bunkus
e5478aea Moritz Bunkus
undef $previous;
29795499 Sven Schöling
undef $filename;
68ca5cc3 Moritz Bunkus
$headers_done = 0;
$content_type = "text/plain";
$boundary_found = 1;
$need_cr = 0;

next;
}

next unless $boundary_found;

if (!$headers_done) {
$line =~ s/[\r\n]*$//;

if (!$line) {
$headers_done = 1;
next;
}

if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
$filename = $1;
substr $line, $-[0], $+[0] - $-[0], "";
}

if ($line =~ m|name\s*=\s*"(.*?)"|i) {
$name = $1;
substr $line, $-[0], $+[0] - $-[0], "";
d319704a Moritz Bunkus
}
68ca5cc3 Moritz Bunkus
6737d960 Moritz Bunkus
$previous = $self->_store_value($name, '') if ($name);
$self->{FILENAME} = $filename if ($filename);
68ca5cc3 Moritz Bunkus
next;
}

if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
$content_type = $1;
d319704a Moritz Bunkus
}
68ca5cc3 Moritz Bunkus
next;
d319704a Moritz Bunkus
}

e5478aea Moritz Bunkus
next unless $previous;
d319704a Moritz Bunkus
e5478aea Moritz Bunkus
${ $previous } .= "${line}\n";
d319704a Moritz Bunkus
}
68ca5cc3 Moritz Bunkus
e5478aea Moritz Bunkus
${ $previous } =~ s|\r?\n$|| if $previous;
68ca5cc3 Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
}

5d557254 Moritz Bunkus
sub _recode_recursively {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
5d557254 Moritz Bunkus
my ($iconv, $param) = @_;

662a225c Sven Schöling
if (any { ref $param eq $_ } qw(Form HASH)) {
5d557254 Moritz Bunkus
foreach my $key (keys %{ $param }) {
if (!ref $param->{$key}) {
97e60d52 Moritz Bunkus
# Workaround for a bug: converting $param->{$key} directly
# leads to 'undef'. I don't know why. Converting a copy works,
# though.
$param->{$key} = $iconv->convert("" . $param->{$key});
5d557254 Moritz Bunkus
} else {
_recode_recursively($iconv, $param->{$key});
}
}

} elsif (ref $param eq 'ARRAY') {
foreach my $idx (0 .. scalar(@{ $param }) - 1) {
if (!ref $param->[$idx]) {
97e60d52 Moritz Bunkus
# Workaround for a bug: converting $param->[$idx] directly
# leads to 'undef'. I don't know why. Converting a copy works,
# though.
$param->[$idx] = $iconv->convert("" . $param->[$idx]);
5d557254 Moritz Bunkus
} else {
_recode_recursively($iconv, $param->[$idx]);
}
}
}
560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
5d557254 Moritz Bunkus
}

d319704a Moritz Bunkus
sub new {
$main::lxdebug->enter_sub();

my $type = shift;

my $self = {};

e7191bc2 Moritz Bunkus
if ($LXDebug::watch_form) {
require SL::Watchdog;
tie %{ $self }, 'SL::Watchdog';
}

570abc83 Moritz Bunkus
bless $self, $type;
d319704a Moritz Bunkus
570abc83 Moritz Bunkus
$self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
$self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0];
d319704a Moritz Bunkus
570abc83 Moritz Bunkus
if ($ENV{CONTENT_LENGTH}) {
my $content;
read STDIN, $content, $ENV{CONTENT_LENGTH};
$self->_request_to_hash($content);
d319704a Moritz Bunkus
}

5d557254 Moritz Bunkus
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;

78f0df90 Moritz Bunkus
my $encoding = $self->{INPUT_ENCODING} || $db_charset;
delete $self->{INPUT_ENCODING};
5d557254 Moritz Bunkus
78f0df90 Moritz Bunkus
_recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
5d557254 Moritz Bunkus
e5478aea Moritz Bunkus
$self->{action} = lc $self->{action};
$self->{action} =~ s/( |-|,|\#)/_/g;

9fc09e82 Sven Donath
#$self->{version} = "2.6.1"; # Old hardcoded but secure style
open VERSION_FILE, "VERSION"; # New but flexible code reads version from VERSION-file
$self->{version} = <VERSION_FILE>;
c8126d0b Moritz Bunkus
close VERSION_FILE;
9fc09e82 Sven Donath
$self->{version} =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

e5478aea Moritz Bunkus
return $self;
d319704a Moritz Bunkus
}

777bf75c Moritz Bunkus
sub _flatten_variables_rec {
$main::lxdebug->enter_sub(2);

my $self = shift;
my $curr = shift;
my $prefix = shift;
my $key = shift;

my @result;

if ('' eq ref $curr->{$key}) {
@result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });

} elsif ('HASH' eq ref $curr->{$key}) {
foreach my $hash_key (sort keys %{ $curr->{$key} }) {
push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
}

} else {
foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
my $first_array_entry = 1;

foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) {
push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
$first_array_entry = 0;
}
}
}

$main::lxdebug->leave_sub(2);

return @result;
}

sub flatten_variables {
$main::lxdebug->enter_sub(2);

my $self = shift;
my @keys = @_;

my @variables;

foreach (@keys) {
push @variables, $self->_flatten_variables_rec($self, '', $_);
}

$main::lxdebug->leave_sub(2);

return @variables;
}

8c7e4493 Moritz Bunkus
sub flatten_standard_variables {
$main::lxdebug->enter_sub(2);

my $self = shift;
my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_);

my @variables;

foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
push @variables, $self->_flatten_variables_rec($self, '', $_);
}

$main::lxdebug->leave_sub(2);

return @variables;
}
777bf75c Moritz Bunkus
d319704a Moritz Bunkus
sub debug {
$main::lxdebug->enter_sub();

my ($self) = @_;

print "\n";

map { print "$_ = $self->{$_}\n" } (sort keys %{$self});

$main::lxdebug->leave_sub();
}

8c7e4493 Moritz Bunkus
sub dumper {
$main::lxdebug->enter_sub(2);

my $self = shift;
my $password = $self->{password};

$self->{password} = 'X' x 8;

local $Data::Dumper::Sortkeys = 1;
my $output = Dumper($self);

$self->{password} = $password;

$main::lxdebug->leave_sub(2);

return $output;
}

d319704a Moritz Bunkus
sub escape {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my ($self, $str) = @_;
d319704a Moritz Bunkus
753b82ff Moritz Bunkus
$str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
d319704a Moritz Bunkus
$str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;

8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
return $str;
}

sub unescape {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my ($self, $str) = @_;

$str =~ tr/+/ /;
$str =~ s/\\$//;

$str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;

8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
return $str;
}

3aaf323a Stephan Köhler
sub quote {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my ($self, $str) = @_;

081a4f97 Moritz Bunkus
if ($str && !ref($str)) {
8b68b3f8 Moritz Bunkus
$str =~ s/\"/&quot;/g;
3aaf323a Stephan Köhler
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aae3709 Moritz Bunkus
return $str;
3aaf323a Stephan Köhler
}

sub unquote {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my ($self, $str) = @_;

081a4f97 Moritz Bunkus
if ($str && !ref($str)) {
8b68b3f8 Moritz Bunkus
$str =~ s/&quot;/\"/g;
3aaf323a Stephan Köhler
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aae3709 Moritz Bunkus
return $str;
3aaf323a Stephan Köhler
}

sub hide_form {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my $self = shift;

if (@_) {
ef17e41a Moritz Bunkus
map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
3aaf323a Stephan Köhler
} else {
081a4f97 Moritz Bunkus
for (sort keys %$self) {
ef17e41a Moritz Bunkus
next if (($_ eq "header") || (ref($self->{$_}) ne ""));
print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
081a4f97 Moritz Bunkus
}
3aaf323a Stephan Köhler
}
560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aaf323a Stephan Köhler
}

d319704a Moritz Bunkus
sub error {
$main::lxdebug->enter_sub();

142f7c2c Moritz Bunkus
$main::lxdebug->show_backtrace();
4b17bfa8 Moritz Bunkus
d319704a Moritz Bunkus
my ($self, $msg) = @_;
if ($ENV{HTTP_USER_AGENT}) {
$msg =~ s/\n/<br>/g;
637325bb Moritz Bunkus
$self->show_generic_error($msg);
d319704a Moritz Bunkus
} else {
b2945bf6 Sven Schöling
print STDERR "Error: $msg\n";
::end_of_request();
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

sub info {
$main::lxdebug->enter_sub();

my ($self, $msg) = @_;

if ($ENV{HTTP_USER_AGENT}) {
$msg =~ s/\n/<br>/g;

if (!$self->{header}) {
$self->header;
61d89baf Sven Donath
print qq|<body>|;
d319704a Moritz Bunkus
}

print qq|
61d89baf Sven Donath
<p class="message_ok"><b>$msg</b></p>
c8126d0b Moritz Bunkus
38e7a330 Sven Donath
<script type="text/javascript">
<!--
9fc09e82 Sven Donath
// If JavaScript is enabled, the whole thing will be reloaded.
// The reason is: When one changes his menu setup (HTML / XUL / CSS ...)
// it now loads the correct code into the browser instead of do nothing.
setTimeout("top.frames.location.href='login.pl'",500);
38e7a330 Sven Donath
//-->
</script>
c8126d0b Moritz Bunkus
61d89baf Sven Donath
</body>
d319704a Moritz Bunkus
|;

} else {

if ($self->{info_function}) {
&{ $self->{info_function} }($msg);
} else {
print "$msg\n";
}
}

$main::lxdebug->leave_sub();
}

29795499 Sven Schöling
# calculates the number of rows in a textarea based on the content and column number
# can be capped with maxrows
d319704a Moritz Bunkus
sub numtextrows {
$main::lxdebug->enter_sub();
8c7e4493 Moritz Bunkus
my ($self, $str, $cols, $maxrows, $minrows) = @_;

$minrows ||= 1;
d319704a Moritz Bunkus
29795499 Sven Schöling
my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
$maxrows ||= $rows;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
8c7e4493 Moritz Bunkus
return max(min($rows, $maxrows), $minrows);
d319704a Moritz Bunkus
}

sub dberror {
$main::lxdebug->enter_sub();

my ($self, $msg) = @_;

$self->error("$msg\n" . $DBI::errstr);

$main::lxdebug->leave_sub();
}

sub isblank {
$main::lxdebug->enter_sub();

my ($self, $name, $msg) = @_;

777bf75c Moritz Bunkus
my $curr = $self;
7db5b95a Moritz Bunkus
foreach my $part (split m/\./, $name) {
777bf75c Moritz Bunkus
if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
$self->error($msg);
}
$curr = $curr->{$part};
d319704a Moritz Bunkus
}
777bf75c Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

ad9563c8 Moritz Bunkus
sub _get_request_uri {
my $self = shift;

return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};

my $scheme = $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http';
my $port = $ENV{SERVER_PORT} || '';
$port = undef if (($scheme eq 'http' ) && ($port == 80))
|| (($scheme eq 'https') && ($port == 443));

my $uri = URI->new("${scheme}://");
$uri->scheme($scheme);
$uri->port($port);
$uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
$uri->path_query($ENV{REQUEST_URI});
$uri->query('');

return $uri;
}

63b61189 Moritz Bunkus
sub _add_to_request_uri {
my $self = shift;

my $relative_new_path = shift;
my $request_uri = shift || $self->_get_request_uri;
my $relative_new_uri = URI->new($relative_new_path);
my @request_segments = $request_uri->path_segments;

my $new_uri = $request_uri->clone;
$new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments);

return $new_uri;
}

0c75bd00 Moritz Bunkus
sub create_http_response {
$main::lxdebug->enter_sub();

my $self = shift;
my %params = @_;

my $cgi = $main::cgi;
$cgi ||= CGI->new('');

my $session_cookie;
if (defined $main::auth) {
07036bf1 Moritz Bunkus
my $uri = $self->_get_request_uri;
my @segments = $uri->path_segments;
pop @segments;
$uri->path_segments(@segments);

0c75bd00 Moritz Bunkus
my $session_cookie_value = $main::auth->get_session_id();
$session_cookie_value ||= 'NO_SESSION';

a50a0e0b Sven Schöling
$session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
'-value' => $session_cookie_value,
07036bf1 Moritz Bunkus
'-path' => $uri->path,
a50a0e0b Sven Schöling
'-secure' => $ENV{HTTPS});
0c75bd00 Moritz Bunkus
}

7b2d21f4 Moritz Bunkus
my %cgi_params = ('-type' => $params{content_type});
704e9499 Moritz Bunkus
$cgi_params{'-charset'} = $params{charset} if ($params{charset});
0c75bd00 Moritz Bunkus
my $output = $cgi->header('-cookie' => $session_cookie,
%cgi_params);

$main::lxdebug->leave_sub();

return $output;
}


d319704a Moritz Bunkus
sub header {
50365526 Sven Schöling
$::lxdebug->enter_sub;
d319704a Moritz Bunkus
50365526 Sven Schöling
# extra code is currently only used by menuv3 and menuv4 to set their css.
260f51fe Sven Schöling
# it is strongly deprecated, and will be changed in a future version.
e98e2094 Moritz Bunkus
my ($self, $extra_code) = @_;
50365526 Sven Schöling
my $db_charset = $::dbcharset || Common::DEFAULT_CHARSET;
my @header;
d319704a Moritz Bunkus
50365526 Sven Schöling
$::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
faef45c2 Moritz Bunkus
50365526 Sven Schöling
$self->{favicon} ||= "favicon.ico";
$self->{titlebar} = "$self->{title} - $self->{titlebar}" if $self->{title};
154fc71c Moritz Bunkus
50365526 Sven Schöling
# build includes
if ($self->{refresh_url} || $self->{refresh_time}) {
my $refresh_time = $self->{refresh_time} || 3;
my $refresh_url = $self->{refresh_url} || $ENV{REFERER};
push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
}
d319704a Moritz Bunkus
50365526 Sven Schöling
push @header, "<link rel='stylesheet' href='css/$_' type='text/css' title='Lx-Office stylesheet'>"
for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets};

push @header, "<style type='text/css'>\@page { size:landscape; }</style>" if $self->{landscape};
push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
push @header, '<script type="text/javascript" src="js/jquery.js"></script>',
'<script type="text/javascript" src="js/common.js"></script>',
1fce9d15 Sven Schöling
'<style type="text/css">@import url(js/jscalendar/calendar-win2k-1.css);</style>',
50365526 Sven Schöling
'<script type="text/javascript" src="js/jscalendar/calendar.js"></script>',
'<script type="text/javascript" src="js/jscalendar/lang/calendar-de.js"></script>',
'<script type="text/javascript" src="js/jscalendar/calendar-setup.js"></script>',
'<script type="text/javascript" src="js/part_selection.js"></script>';
push @header, $self->{javascript} if $self->{javascript};
push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
push @header, "<script type='text/javascript'>function fokus(){ document.$self->{fokus}.focus(); }</script>" if $self->{fokus};
push @header, sprintf "<script type='text/javascript'>top.document.title='%s';</script>",
join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title};

12e51300 Moritz Bunkus
# if there is a title, we put some JavaScript in to the page, wich writes a
# meaningful title-tag for our frameset.
my $title_hack = '';
if ($self->{title}) {
$title_hack = qq|
<script type="text/javascript">
<!--
// Write a meaningful title-tag for our frameset.
top.document.title="| . $self->{"title"} . qq| - | . $self->{"login"} . qq| - | . $::myconfig{dbname} . qq| - V| . $self->{"version"} . qq|";
//-->
</script>|;
}

50365526 Sven Schöling
# output
print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
print "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01//EN' 'http://www.w3.org/TR/html4/strict.dtd'>\n"
if $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE.
print <<EOT;
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=$db_charset">
d319704a Moritz Bunkus
<title>$self->{titlebar}</title>
50365526 Sven Schöling
EOT
print " $_\n" for @header;
print <<EOT;
6be015fa Sven Schöling
<link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
6a4c2859 Philip Reetz
<meta name="robots" content="noindex,nofollow" />
50365526 Sven Schöling
<script type="text/javascript" src="js/highlight_input.js"></script>
256c879b Moritz Bunkus
<link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
54e4131e Moritz Bunkus
<script type="text/javascript" src="js/tabcontent.js">
ef17e41a Moritz Bunkus
54e4131e Moritz Bunkus
/***********************************************
256c879b Moritz Bunkus
* Tab Content script v2.2- ? Dynamic Drive DHTML code library (www.dynamicdrive.com)
* This notice MUST stay intact for legal use
* Visit Dynamic Drive at http://www.dynamicdrive.com/ for full source code
***********************************************/
ef17e41a Moritz Bunkus
54e4131e Moritz Bunkus
</script>
e98e2094 Moritz Bunkus
$extra_code
12e51300 Moritz Bunkus
$title_hack
50365526 Sven Schöling
</head>
d319704a Moritz Bunkus
50365526 Sven Schöling
EOT
d319704a Moritz Bunkus
50365526 Sven Schöling
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
}

08ca74a8 Moritz Bunkus
sub ajax_response_header {
$main::lxdebug->enter_sub();

my ($self) = @_;

my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
my $cgi = $main::cgi || CGI->new('');
my $output = $cgi->header('-charset' => $db_charset);

$main::lxdebug->leave_sub();

return $output;
}

ad9563c8 Moritz Bunkus
sub redirect_header {
my $self = shift;
my $new_url = shift;

my $base_uri = $self->_get_request_uri;
my $new_uri = URI->new_abs($new_url, $base_uri);

die "Headers already sent" if $::self->{header};
$self->{header} = 1;

my $cgi = $main::cgi || CGI->new('');
return $cgi->redirect($new_uri);
}

dc50b737 Sven Schöling
sub set_standard_title {
$::lxdebug->enter_sub;
my $self = shift;

$self->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $self->{version}";
$self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name};
$self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};

$::lxdebug->leave_sub;
}

bf3cc4b6 Moritz Bunkus
sub _prepare_html_template {
99ccfeab Moritz Bunkus
$main::lxdebug->enter_sub();

2787b39a Moritz Bunkus
my ($self, $file, $additional_params) = @_;
af85b761 Moritz Bunkus
my $language;
40db40e8 Moritz Bunkus
f59ed16f Sven Schöling
if (!%::myconfig || !$::myconfig{"countrycode"}) {
af85b761 Moritz Bunkus
$language = $main::language;
} else {
$language = $main::myconfig{"countrycode"};
}
f65faf20 Moritz Bunkus
$language = "de" unless ($language);
af85b761 Moritz Bunkus
79038417 Moritz Bunkus
if (-f "templates/webpages/${file}.html") {
if ((-f ".developer") && ((stat("templates/webpages/${file}.html"))[9] > (stat("locale/${language}/all"))[9])) {
my $info = "Developer information: templates/webpages/${file}.html is newer than the translation file locale/${language}/all.\n" .
af85b761 Moritz Bunkus
"Please re-run 'locales.pl' in 'locale/${language}'.";
666f9ee4 Moritz Bunkus
print(qq|<pre>$info</pre>|);
b2945bf6 Sven Schöling
::end_of_request();
666f9ee4 Moritz Bunkus
}

40db40e8 Moritz Bunkus
$file = "templates/webpages/${file}.html";
79038417 Moritz Bunkus
40db40e8 Moritz Bunkus
} else {
0dfd8e90 Moritz Bunkus
my $info = "Web page template '${file}' not found.\n" .
af85b761 Moritz Bunkus
"Please re-run 'locales.pl' in 'locale/${language}'.";
0dfd8e90 Moritz Bunkus
print(qq|<pre>$info</pre>|);
b2945bf6 Sven Schöling
::end_of_request();
40db40e8 Moritz Bunkus
}
99ccfeab Moritz Bunkus
86be28e9 Moritz Bunkus
if ($self->{"DEBUG"}) {
$additional_params->{"DEBUG"} = $self->{"DEBUG"};
99ccfeab Moritz Bunkus
}

86be28e9 Moritz Bunkus
if ($additional_params->{"DEBUG"}) {
$additional_params->{"DEBUG"} =
"<br><em>DEBUG INFORMATION:</em><pre>" . $additional_params->{"DEBUG"} . "</pre>";
}

d1c335e9 Moritz Bunkus
if (%main::myconfig) {
22ae0bf0 Sven Schöling
$::myconfig{jsc_dateformat} = apply {
s/d+/\%d/gi;
s/m+/\%m/gi;
s/y+/\%Y/gi;
} $::myconfig{"dateformat"};
53d06080 Sven Schöling
$additional_params->{"myconfig"} ||= \%::myconfig;
22ae0bf0 Sven Schöling
map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
d1c335e9 Moritz Bunkus
}

812fdc05 Wulf Coulmann
$additional_params->{"conf_dbcharset"} = $::dbcharset;
$additional_params->{"conf_webdav"} = $::webdav;
$additional_params->{"conf_lizenzen"} = $::lizenzen;
$additional_params->{"conf_latex_templates"} = $::latex;
$additional_params->{"conf_opendocument_templates"} = $::opendocument_templates;
$additional_params->{"conf_vertreter"} = $::vertreter;
$additional_params->{"conf_show_best_before"} = $::show_best_before;
$additional_params->{"conf_parts_image_css"} = $::parts_image_css;
$additional_params->{"conf_parts_listing_images"} = $::parts_listing_images;
$additional_params->{"conf_parts_show_image"} = $::parts_show_image;
d1c335e9 Moritz Bunkus
b54e817d Moritz Bunkus
if (%main::debug_options) {
map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
}

8c7e4493 Moritz Bunkus
if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) {
while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) {
$additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value;
}
}

bf3cc4b6 Moritz Bunkus
$main::lxdebug->leave_sub();

return $file;
}

9aaca433 Moritz Bunkus
sub parse_html_template {
bf3cc4b6 Moritz Bunkus
$main::lxdebug->enter_sub();

my ($self, $file, $additional_params) = @_;

$additional_params ||= { };

567c0d7c Sven Schöling
my $real_file = $self->_prepare_html_template($file, $additional_params);
my $template = $self->template || $self->init_template;
bf3cc4b6 Moritz Bunkus
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };

my $output;
567c0d7c Sven Schöling
$template->process($real_file, $additional_params, \$output) || die $template->error;
bf3cc4b6 Moritz Bunkus
$main::lxdebug->leave_sub();

return $output;
}

567c0d7c Sven Schöling
sub init_template {
my $self = shift;

return if $self->template;

return $self->template(Template->new({
'INTERPOLATE' => 0,
'EVAL_PERL' => 0,
'ABSOLUTE' => 1,
'CACHE_SIZE' => 0,
'PLUGIN_BASE' => 'SL::Template::Plugin',
'INCLUDE_PATH' => '.:templates/webpages',
ed5b92f8 Moritz Bunkus
'COMPILE_EXT' => '.tcc',
'COMPILE_DIR' => $::userspath . '/templates-cache',
567c0d7c Sven Schöling
})) || die;
}

sub template {
my $self = shift;
$self->{template_object} = shift if @_;
return $self->{template_object};
}

99ccfeab Moritz Bunkus
sub show_generic_error {
02d89fd6 Moritz Bunkus
$main::lxdebug->enter_sub();

5c184abc Moritz Bunkus
my ($self, $error, %params) = @_;
99ccfeab Moritz Bunkus
83cc6a5b Moritz Bunkus
my $add_params = {
5c184abc Moritz Bunkus
'title_error' => $params{title},
83cc6a5b Moritz Bunkus
'label_error' => $error,
};
99ccfeab Moritz Bunkus
5c184abc Moritz Bunkus
if ($params{action}) {
my @vars;

map { delete($self->{$_}); } qw(action);
map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self };

$add_params->{SHOW_BUTTON} = 1;
$add_params->{BUTTON_LABEL} = $params{label} || $params{action};
$add_params->{VARIABLES} = \@vars;

} elsif ($params{back_button}) {
$add_params->{SHOW_BACK_BUTTON} = 1;
7d82f0e8 Moritz Bunkus
}

d71bfc9b Sven Schöling
$self->{title} = $params{title} if $params{title};
83cc6a5b Moritz Bunkus
d1c335e9 Moritz Bunkus
$self->header();
9aaca433 Moritz Bunkus
print $self->parse_html_template("generic/error", $add_params);
d1c335e9 Moritz Bunkus
b2945bf6 Sven Schöling
print STDERR "Error: $error\n";

02d89fd6 Moritz Bunkus
$main::lxdebug->leave_sub();

b2945bf6 Sven Schöling
::end_of_request();
d1c335e9 Moritz Bunkus
}

sub show_generic_information {
02d89fd6 Moritz Bunkus
$main::lxdebug->enter_sub();

83cc6a5b Moritz Bunkus
my ($self, $text, $title) = @_;

my $add_params = {
'title_information' => $title,
'label_information' => $text,
};
d1c335e9 Moritz Bunkus
83cc6a5b Moritz Bunkus
$self->{title} = $title if ($title);
d1c335e9 Moritz Bunkus
$self->header();
9aaca433 Moritz Bunkus
print $self->parse_html_template("generic/information", $add_params);
d1c335e9 Moritz Bunkus
02d89fd6 Moritz Bunkus
$main::lxdebug->leave_sub();

b2945bf6 Sven Schöling
::end_of_request();
99ccfeab Moritz Bunkus
}

487d4f1f Stephan Köhler
# write Trigger JavaScript-Code ($qty = quantity of Triggers)
# changed it to accept an arbitrary number of triggers - sschoeling
d319704a Moritz Bunkus
sub write_trigger {
$main::lxdebug->enter_sub();

487d4f1f Stephan Köhler
my $self = shift;
my $myconfig = shift;
my $qty = shift;
d319704a Moritz Bunkus
# set dateform for jsscript
# default
cb0d3042 Moritz Bunkus
my %dateformats = (
"dd.mm.yy" => "%d.%m.%Y",
"dd-mm-yy" => "%d-%m-%Y",
"dd/mm/yy" => "%d/%m/%Y",
"mm/dd/yy" => "%m/%d/%Y",
"mm-dd-yy" => "%m-%d-%Y",
"yyyy-mm-dd" => "%Y-%m-%d",
);

d71bfc9b Sven Schöling
my $ifFormat = defined($dateformats{$myconfig->{"dateformat"}}) ?
$dateformats{$myconfig->{"dateformat"}} : "%d.%m.%Y";
d319704a Moritz Bunkus
cb0d3042 Moritz Bunkus
my @triggers;
487d4f1f Stephan Köhler
while ($#_ >= 2) {
push @triggers, qq|
d319704a Moritz Bunkus
Calendar.setup(
07d71c33 Stephan Köhler
{
081a4f97 Moritz Bunkus
inputField : "| . (shift) . qq|",
07d71c33 Stephan Köhler
ifFormat :"$ifFormat",
ef17e41a Moritz Bunkus
align : "| . (shift) . qq|",
081a4f97 Moritz Bunkus
button : "| . (shift) . qq|"
07d71c33 Stephan Köhler
}
);
d319704a Moritz Bunkus
|;
}
d1c335e9 Moritz Bunkus
my $jsscript = qq|
d319704a Moritz Bunkus
<script type="text/javascript">
081a4f97 Moritz Bunkus
<!--| . join("", @triggers) . qq|//-->
d319704a Moritz Bunkus
</script>
|;

$main::lxdebug->leave_sub();

return $jsscript;
} #end sub write_trigger

sub redirect {
$main::lxdebug->enter_sub();

my ($self, $msg) = @_;

dc50b737 Sven Schöling
if (!$self->{callback}) {
d319704a Moritz Bunkus
$self->info($msg);
b2945bf6 Sven Schöling
::end_of_request();
d319704a Moritz Bunkus
}

dc50b737 Sven Schöling
# my ($script, $argv) = split(/\?/, $self->{callback}, 2);
# $script =~ s|.*/||;
# $script =~ s|[^a-zA-Z0-9_\.]||g;
# exec("perl", "$script", $argv);

print $::form->redirect_header($self->{callback});

d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# sort of columns removed - empty sub
sub sort_columns {
$main::lxdebug->enter_sub();

my ($self, @columns) = @_;

$main::lxdebug->leave_sub();

return @columns;
}
e5e6947b Moritz Bunkus
#
d319704a Moritz Bunkus
sub format_amount {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my ($self, $myconfig, $amount, $places, $dash) = @_;
ef17e41a Moritz Bunkus
55f4154b Philip Reetz
if ($amount eq "") {
$amount = 0;
}
f54fd660 Sven Schöling
e3232a58 Udo Spallek
# Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
f54fd660 Sven Schöling
e3232a58 Udo Spallek
my $neg = ($amount =~ s/^-//);
my $exp = ($amount =~ m/[e]/) ? 1 : 0;
f54fd660 Sven Schöling
377ff409 Moritz Bunkus
if (defined($places) && ($places ne '')) {
e3232a58 Udo Spallek
if (not $exp) {
if ($places < 0) {
$amount *= 1;
$places *= -1;

my ($actual_places) = ($amount =~ /\.(\d+)/);
$actual_places = length($actual_places);
$places = $actual_places > $places ? $actual_places : $places;
}
ac0c6a86 Moritz Bunkus
}
$amount = $self->round_amount($amount, $places);
}
54e4131e Moritz Bunkus
e5e6947b Moritz Bunkus
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
97d71ce1 Moritz Bunkus
my @p = split(/\./, $amount); # split amount at decimal point
54e4131e Moritz Bunkus
e5e6947b Moritz Bunkus
$p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
d319704a Moritz Bunkus
e5e6947b Moritz Bunkus
$amount = $p[0];
$amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne '');
55f4154b Philip Reetz
582f4e7c Moritz Bunkus
$amount = do {
34366eda Moritz Bunkus
($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
($neg ? "-$amount" : "$amount" ) ;
582f4e7c Moritz Bunkus
};
ef17e41a Moritz Bunkus
55f4154b Philip Reetz
8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
return $amount;
}
8c7e4493 Moritz Bunkus
sub format_amount_units {
$main::lxdebug->enter_sub();

my $self = shift;
my %params = @_;

my $myconfig = \%main::myconfig;
5b0ec556 Moritz Bunkus
my $amount = $params{amount} * 1;
8c7e4493 Moritz Bunkus
my $places = $params{places};
my $part_unit_name = $params{part_unit};
my $amount_unit_name = $params{amount_unit};
my $conv_units = $params{conv_units};
my $max_places = $params{max_places};

5b0ec556 Moritz Bunkus
if (!$part_unit_name) {
$main::lxdebug->leave_sub();
return '';
}

8c7e4493 Moritz Bunkus
AM->retrieve_all_units();
my $all_units = $main::all_units;

if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
$conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
}

if (!scalar @{ $conv_units }) {
my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
$main::lxdebug->leave_sub();
return $result;
}

my $part_unit = $all_units->{$part_unit_name};
my $conv_unit = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;

$amount *= $conv_unit->{factor};

my @values;
d71bfc9b Sven Schöling
my $num;
8c7e4493 Moritz Bunkus
foreach my $unit (@$conv_units) {
my $last = $unit->{name} eq $part_unit->{name};
if (!$last) {
$num = int($amount / $unit->{factor});
$amount -= $num * $unit->{factor};
}

if ($last ? $amount : $num) {
push @values, { "unit" => $unit->{name},
"amount" => $last ? $amount / $unit->{factor} : $num,
"places" => $last ? $places : 0 };
}

last if $last;
}

if (!@values) {
push @values, { "unit" => $part_unit_name,
"amount" => 0,
"places" => 0 };
}

my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;

$main::lxdebug->leave_sub();

return $result;
}
b14c2015 Moritz Bunkus
sub format_string {
$main::lxdebug->enter_sub(2);

my $self = shift;
my $input = shift;

$input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx;
$input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
$input =~ s/\#\#/\#/g;

$main::lxdebug->leave_sub(2);

return $input;
}

8c7e4493 Moritz Bunkus
#

d319704a Moritz Bunkus
sub parse_amount {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my ($self, $myconfig, $amount) = @_;
081a4f97 Moritz Bunkus
58fcb69f Stephan Köhler
if ( ($myconfig->{numberformat} eq '1.000,00')
|| ($myconfig->{numberformat} eq '1000,00')) {
$amount =~ s/\.//g;
$amount =~ s/,/\./;
}
d319704a Moritz Bunkus
58fcb69f Stephan Köhler
if ($myconfig->{numberformat} eq "1'000.00") {
8b68b3f8 Moritz Bunkus
$amount =~ s/\'//g;
d319704a Moritz Bunkus
}

58fcb69f Stephan Köhler
$amount =~ s/,//g;
081a4f97 Moritz Bunkus
8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
081a4f97 Moritz Bunkus
d319704a Moritz Bunkus
return ($amount * 1);
}

sub round_amount {
8c6efb2a Moritz Bunkus
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my ($self, $amount, $places) = @_;
becc49b1 Stephan Köhler
my $round_amount;
d319704a Moritz Bunkus
b36ef567 Moritz Bunkus
# Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )

# Round amounts to eight places before rounding to the requested
# number of places. This gets rid of errors due to internal floating
# point representation.
$amount = $self->round_amount($amount, 8) if $places < 8;
$amount = $amount * (10**($places));
081a4f97 Moritz Bunkus
$round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
d319704a Moritz Bunkus
8c6efb2a Moritz Bunkus
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
becc49b1 Stephan Köhler
return $round_amount;
3aaf323a Stephan Köhler
081a4f97 Moritz Bunkus
}
3aaf323a Stephan Köhler
d319704a Moritz Bunkus
sub parse_template {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $userspath) = @_;
0fba3edd Moritz Bunkus
my $out;
974b5d86 Moritz Bunkus
local (*IN, *OUT);
54e4131e Moritz Bunkus
$self->{"cwd"} = getcwd();
$self->{"tmpdir"} = $self->{cwd} . "/${userspath}";

49c7621e Moritz Bunkus
my $ext_for_format;

0fba3edd Moritz Bunkus
my $template_type;
54e4131e Moritz Bunkus
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
0fba3edd Moritz Bunkus
$template_type = 'OpenDocument';
66c91148 Moritz Bunkus
$ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
49c7621e Moritz Bunkus
54e4131e Moritz Bunkus
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
$ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"};
0fba3edd Moritz Bunkus
$template_type = 'LaTeX';
49c7621e Moritz Bunkus
$ext_for_format = 'pdf';

} elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
0fba3edd Moritz Bunkus
$template_type = 'HTML';
49c7621e Moritz Bunkus
$ext_for_format = 'html';

} elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
0fba3edd Moritz Bunkus
$template_type = 'XML';
49c7621e Moritz Bunkus
$ext_for_format = 'xml';

0fba3edd Moritz Bunkus
} elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
79855851 Sven Schöling
$template_type = 'XML';
49c7621e Moritz Bunkus
90815a31 Joachim Zach
} elsif ( $self->{"format"} =~ /excel/i ) {
0fba3edd Moritz Bunkus
$template_type = 'Excel';
90815a31 Joachim Zach
$ext_for_format = 'xls';

9f055edb Udo Spallek
} elsif ( defined $self->{'format'}) {
$self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
49c7621e Moritz Bunkus
9f055edb Udo Spallek
} elsif ( $self->{'format'} eq '' ) {
$self->error("No Outputformat given: $self->{'format'}");
49c7621e Moritz Bunkus
9f055edb Udo Spallek
} else { #Catch the rest
ef17e41a Moritz Bunkus
$self->error("Outputformat not defined: $self->{'format'}");
54e4131e Moritz Bunkus
}
d319704a Moritz Bunkus
0fba3edd Moritz Bunkus
my $template = SL::Template::create(type => $template_type,
file_name => $self->{IN},
form => $self,
myconfig => $myconfig,
userspath => $userspath);

d319704a Moritz Bunkus
# 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" };

6c56877d Moritz Bunkus
if (!$self->{employee_id}) {
map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns);
}
d319704a Moritz Bunkus
79778ae9 Moritz Bunkus
map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid);
e3232a58 Udo Spallek
d319704a Moritz Bunkus
$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;
e1e19a48 Moritz Bunkus
my $prepend_userspath;

if (!$self->{tmpfile}) {
$self->{tmpfile} = "${fileid}.$self->{IN}";
$prepend_userspath = 1;
}

$prepend_userspath = 1 if substr($self->{tmpfile}, 0, length $userspath) eq $userspath;

$self->{tmpfile} =~ s|.*/||;
$self->{tmpfile} =~ s/[^a-zA-Z0-9\._\ \-]//g;
$self->{tmpfile} = "$userspath/$self->{tmpfile}" if $prepend_userspath;
974b5d86 Moritz Bunkus
54e4131e Moritz Bunkus
if ($template->uses_temp_file() || $self->{media} eq 'email') {
d319704a Moritz Bunkus
$out = $self->{OUT};
$self->{OUT} = ">$self->{tmpfile}";
}

f41c4ade Moritz Bunkus
my $result;

d319704a Moritz Bunkus
if ($self->{OUT}) {
f41c4ade Moritz Bunkus
open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!");
$result = $template->parse(*OUT);
close OUT;

d319704a Moritz Bunkus
} else {
$self->header;
f41c4ade Moritz Bunkus
$result = $template->parse(*STDOUT);
d319704a Moritz Bunkus
}

f41c4ade Moritz Bunkus
if (!$result) {
54e4131e Moritz Bunkus
$self->cleanup();
$self->error("$self->{IN} : " . $template->get_error());
d319704a Moritz Bunkus
}

54e4131e Moritz Bunkus
if ($template->uses_temp_file() || $self->{media} eq 'email') {
d319704a Moritz Bunkus
if ($self->{media} eq 'email') {

my $mail = new Mailer;

map { $mail->{$_} = $self->{$_} }
faef45c2 Moritz Bunkus
qw(cc bcc subject message version format);
$mail->{charset} = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
a63aaabd Moritz Bunkus
$mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
d319704a Moritz Bunkus
$mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
$mail->{fileid} = "$fileid.";
8c7e4493 Moritz Bunkus
$myconfig->{signature} =~ s/\r//g;
d319704a Moritz Bunkus
# if we send html or plain text inline
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
$mail->{contenttype} = "text/html";

8c7e4493 Moritz Bunkus
$mail->{message} =~ s/\r//g;
$mail->{message} =~ s/\n/<br>\n/g;
$myconfig->{signature} =~ s/\n/<br>\n/g;
ef6f0c29 Moritz Bunkus
$mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
d319704a Moritz Bunkus
open(IN, $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
while (<IN>) {
$mail->{message} .= $_;
}

close(IN);

} else {

3d779763 Moritz Bunkus
if (!$self->{"do_not_attach"}) {
49c7621e Moritz Bunkus
my $attachment_name = $self->{attachment_filename} || $self->{tmpfile};
$attachment_name =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
$mail->{attachments} = [{ "filename" => $self->{tmpfile},
"name" => $attachment_name }];
3d779763 Moritz Bunkus
}
d319704a Moritz Bunkus
8c7e4493 Moritz Bunkus
$mail->{message} =~ s/\r//g;
$mail->{message} .= "\n-- \n$myconfig->{signature}";
d319704a Moritz Bunkus
}

974b5d86 Moritz Bunkus
my $err = $mail->send();
d319704a Moritz Bunkus
$self->error($self->cleanup . "$err") if ($err);

} else {

$self->{OUT} = $out;

my $numbytes = (-s $self->{tmpfile});
open(IN, $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");

$self->{copies} = 1 unless $self->{media} eq 'printer';

chdir("$self->{cwd}");
54e4131e Moritz Bunkus
#print(STDERR "Kopien $self->{copies}\n");
#print(STDERR "OUT $self->{OUT}\n");
d319704a Moritz Bunkus
for my $i (1 .. $self->{copies}) {
if ($self->{OUT}) {
5ab97a89 Sven Schöling
open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
print OUT while <IN>;
close OUT;
seek IN, 0, 0;

d319704a Moritz Bunkus
} else {
f54fd660 Sven Schöling
$self->{attachment_filename} = ($self->{attachment_filename})
68c57596 Udo Spallek
? $self->{attachment_filename}
: $self->generate_attachment_filename();
564d8509 Sven Schöling
d319704a Moritz Bunkus
# launch application
54e4131e Moritz Bunkus
print qq|Content-Type: | . $template->get_mime_type() . qq|
c1fc6437 Udo Spallek
Content-Disposition: attachment; filename="$self->{attachment_filename}"
d319704a Moritz Bunkus
Content-Length: $numbytes

|;

5ab97a89 Sven Schöling
$::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
d319704a Moritz Bunkus
}
}

close(IN);
}

}

d1c335e9 Moritz Bunkus
$self->cleanup;

d319704a Moritz Bunkus
chdir("$self->{cwd}");
$main::lxdebug->leave_sub();
}

6a751412 Moritz Bunkus
sub get_formname_translation {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
6a751412 Moritz Bunkus
my ($self, $formname) = @_;

$formname ||= $self->{formname};
564d8509 Sven Schöling
my %formname_translations = (
d707f7ac Moritz Bunkus
bin_list => $main::locale->text('Bin List'),
credit_note => $main::locale->text('Credit Note'),
invoice => $main::locale->text('Invoice'),
pick_list => $main::locale->text('Pick List'),
proforma => $main::locale->text('Proforma Invoice'),
purchase_order => $main::locale->text('Purchase Order'),
request_quotation => $main::locale->text('RFQ'),
sales_order => $main::locale->text('Confirmation'),
sales_quotation => $main::locale->text('Quotation'),
storno_invoice => $main::locale->text('Storno Invoice'),
sales_delivery_order => $main::locale->text('Delivery Order'),
purchase_delivery_order => $main::locale->text('Delivery Order'),
8e08bedb Sven Schöling
dunning => $main::locale->text('Dunning'),
564d8509 Sven Schöling
);

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
6a751412 Moritz Bunkus
return $formname_translations{$formname}
}

afe54bed Moritz Bunkus
sub get_number_prefix_for_type {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
6a751412 Moritz Bunkus
my ($self) = @_;

d707f7ac Moritz Bunkus
my $prefix =
(first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
: ($self->{type} =~ /_quotation$/) ? 'quo'
: ($self->{type} =~ /_delivery_order$/) ? 'do'
: 'ord';
564d8509 Sven Schöling
560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $prefix;
}

sub get_extension_for_format {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

my $extension = $self->{format} =~ /pdf/i ? ".pdf"
: $self->{format} =~ /postscript/i ? ".ps"
: $self->{format} =~ /opendocument/i ? ".odt"
90815a31 Joachim Zach
: $self->{format} =~ /excel/i ? ".xls"
afe54bed Moritz Bunkus
: $self->{format} =~ /html/i ? ".html"
: "";

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $extension;
}

sub generate_attachment_filename {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();

6826e7ed Moritz Bunkus
if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
$attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format();

} elsif ($attachment_filename && $self->{"${prefix}number"}) {
afe54bed Moritz Bunkus
$attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
6826e7ed Moritz Bunkus
564d8509 Sven Schöling
} else {
$attachment_filename = "";
}

6826e7ed Moritz Bunkus
$attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename);
$attachment_filename =~ s|[\s/\\]+|_|g;

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
564d8509 Sven Schöling
return $attachment_filename;
}

afe54bed Moritz Bunkus
sub generate_email_subject {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();

if ($subject && $self->{"${prefix}number"}) {
$subject .= " " . $self->{"${prefix}number"}
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $subject;
}

d319704a Moritz Bunkus
sub cleanup {
$main::lxdebug->enter_sub();

my $self = shift;

chdir("$self->{tmpdir}");

my @err = ();
if (-f "$self->{tmpfile}.err") {
open(FH, "$self->{tmpfile}.err");
@err = <FH>;
close(FH);
}

5e043871 Sven Schöling
if ($self->{tmpfile} && ! $::keep_temp_files) {
54e4131e Moritz Bunkus
$self->{tmpfile} =~ s|.*/||g;
# strip extension
$self->{tmpfile} =~ s/\.\w+$//g;
my $tmpfile = $self->{tmpfile};
unlink(<$tmpfile.*>);
d319704a Moritz Bunkus
}

chdir("$self->{cwd}");

$main::lxdebug->leave_sub();

return "@err";
}

sub datetonum {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
d71bfc9b Sven Schöling
my ($yy, $mm, $dd);
d319704a Moritz Bunkus
if ($date && $date =~ /\D/) {

if ($myconfig->{dateformat} =~ /^yy/) {
($yy, $mm, $dd) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^mm/) {
($mm, $dd, $yy) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^dd/) {
($dd, $mm, $yy) = split /\D/, $date;
}

$dd *= 1;
$mm *= 1;
$yy = ($yy < 70) ? $yy + 2000 : $yy;
$yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;

$dd = "0$dd" if ($dd < 10);
$mm = "0$mm" if ($mm < 10);

$date = "$yy$mm$dd";
}

$main::lxdebug->leave_sub();

return $date;
}

# Database routines used throughout

7535161d Moritz Bunkus
sub _dbconnect_options {
my $self = shift;
my $options = { pg_enable_utf8 => $::locale->is_utf8,
@_ };

return $options;
}

d319704a Moritz Bunkus
sub dbconnect {
07be726d Sven Schöling
$main::lxdebug->enter_sub(2);
d319704a Moritz Bunkus
my ($self, $myconfig) = @_;

# connect to database
7535161d Moritz Bunkus
my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
d319704a Moritz Bunkus
or $self->dberror;

# set db options
if ($myconfig->{dboptions}) {
$dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
}

07be726d Sven Schöling
$main::lxdebug->leave_sub(2);
d319704a Moritz Bunkus
return $dbh;
}

sub dbconnect_noauto {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;
f54fd660 Sven Schöling
d319704a Moritz Bunkus
# connect to database
7535161d Moritz Bunkus
my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
d319704a Moritz Bunkus
or $self->dberror;

# set db options
if ($myconfig->{dboptions}) {
$dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
}

$main::lxdebug->leave_sub();

return $dbh;
}

820f3066 Moritz Bunkus
sub get_standard_dbh {
$main::lxdebug->enter_sub(2);

5548540b Sven Schöling
my $self = shift;
my $myconfig = shift || \%::myconfig;
820f3066 Moritz Bunkus
de06210f Moritz Bunkus
if ($standard_dbh && !$standard_dbh->{Active}) {
c510d88b Sven Schöling
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
de06210f Moritz Bunkus
undef $standard_dbh;
}

820f3066 Moritz Bunkus
$standard_dbh ||= $self->dbconnect_noauto($myconfig);

$main::lxdebug->leave_sub(2);

return $standard_dbh;
}

9e06d0e4 Philip Reetz
sub date_closed {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
my $dbh = $self->dbconnect($myconfig);

my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
my $sth = prepare_execute_query($self, $dbh, $query, $date);
my ($closed) = $sth->fetchrow_array;

$main::lxdebug->leave_sub();

return $closed;
}

d319704a Moritz Bunkus
sub update_balance {
$main::lxdebug->enter_sub();

ef17e41a Moritz Bunkus
my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
d319704a Moritz Bunkus
# if we have a value, go do it
if ($value != 0) {

# retrieve balance from table
my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
ef17e41a Moritz Bunkus
my $sth = prepare_execute_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
my ($balance) = $sth->fetchrow_array;
$sth->finish;

$balance += $value;

# update balance
$query = "UPDATE $table SET $field = $balance WHERE $where";
ef17e41a Moritz Bunkus
do_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
}
$main::lxdebug->leave_sub();
}

sub update_exchangerate {
$main::lxdebug->enter_sub();

my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
29795499 Sven Schöling
my ($query);
d319704a Moritz Bunkus
# some sanity check for currency
if ($curr eq '') {
$main::lxdebug->leave_sub();
return;
f54fd660 Sven Schöling
}
29795499 Sven Schöling
$query = qq|SELECT curr FROM defaults|;
fb37acdc Moritz Bunkus
my ($currency) = selectrow_query($self, $dbh, $query);
my ($defaultcurrency) = split m/:/, $currency;


if ($curr eq $defaultcurrency) {
$main::lxdebug->leave_sub();
return;
d319704a Moritz Bunkus
}

29795499 Sven Schöling
$query = qq|SELECT e.curr FROM exchangerate e
ef17e41a Moritz Bunkus
WHERE e.curr = ? AND e.transdate = ?
FOR UPDATE|;
my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
d319704a Moritz Bunkus
fb37acdc Moritz Bunkus
if ($buy == 0) {
$buy = "";
}
if ($sell == 0) {
$sell = "";
}

$buy = conv_i($buy, "NULL");
$sell = conv_i($sell, "NULL");

d319704a Moritz Bunkus
my $set;
if ($buy != 0 && $sell != 0) {
$set = "buy = $buy, sell = $sell";
} elsif ($buy != 0) {
$set = "buy = $buy";
} elsif ($sell != 0) {
$set = "sell = $sell";
}

if ($sth->fetchrow_array) {
$query = qq|UPDATE exchangerate
SET $set
ef17e41a Moritz Bunkus
WHERE curr = ?
AND transdate = ?|;
f54fd660 Sven Schöling
d319704a Moritz Bunkus
} else {
$query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
ef17e41a Moritz Bunkus
VALUES (?, $buy, $sell, ?)|;
d319704a Moritz Bunkus
}
$sth->finish;
ef17e41a Moritz Bunkus
do_query($self, $dbh, $query, $curr, $transdate);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub save_exchangerate {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;

my $dbh = $self->dbconnect($myconfig);

fb37acdc Moritz Bunkus
my ($buy, $sell);

d319704a Moritz Bunkus
$buy = $rate if $fld eq 'buy';
$sell = $rate if $fld eq 'sell';

fb37acdc Moritz Bunkus
d319704a Moritz Bunkus
$self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);

fb37acdc Moritz Bunkus
d319704a Moritz Bunkus
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

sub get_exchangerate {
$main::lxdebug->enter_sub();

my ($self, $dbh, $curr, $transdate, $fld) = @_;
29795499 Sven Schöling
my ($query);
081a4f97 Moritz Bunkus
626e0240 Stephan Köhler
unless ($transdate) {
$main::lxdebug->leave_sub();
92361072 Moritz Bunkus
return 1;
626e0240 Stephan Köhler
}
d319704a Moritz Bunkus
29795499 Sven Schöling
$query = qq|SELECT curr FROM defaults|;
fb37acdc Moritz Bunkus
my ($currency) = selectrow_query($self, $dbh, $query);
my ($defaultcurrency) = split m/:/, $currency;

if ($currency eq $defaultcurrency) {
$main::lxdebug->leave_sub();
return 1;
}

29795499 Sven Schöling
$query = qq|SELECT e.$fld FROM exchangerate e
ef17e41a Moritz Bunkus
WHERE e.curr = ? AND e.transdate = ?|;
my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
d319704a Moritz Bunkus
fb37acdc Moritz Bunkus
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $exchangerate;
}

ef17e41a Moritz Bunkus
sub check_exchangerate {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $currency, $transdate, $fld) = @_;

1a16973b Sven Schöling
if ($fld !~/^buy|sell$/) {
$self->error('Fatal: check_exchangerate called with invalid buy/sell argument');
}

ef17e41a Moritz Bunkus
unless ($transdate) {
$main::lxdebug->leave_sub();
return "";
}

fb37acdc Moritz Bunkus
my ($defaultcurrency) = $self->get_default_currency($myconfig);

if ($currency eq $defaultcurrency) {
$main::lxdebug->leave_sub();
return 1;
}
ef17e41a Moritz Bunkus
fb37acdc Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT e.$fld FROM exchangerate e
WHERE e.curr = ? AND e.transdate = ?|;
fb37acdc Moritz Bunkus
ef17e41a Moritz Bunkus
my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
b262a6e8 Moritz Bunkus
ef17e41a Moritz Bunkus
$main::lxdebug->leave_sub();

return $exchangerate;
}

bea3f989 Moritz Bunkus
sub get_all_currencies {
fb37acdc Moritz Bunkus
$main::lxdebug->enter_sub();

f88cdcc7 Sven Schöling
my $self = shift;
my $myconfig = shift || \%::myconfig;
my $dbh = $self->get_standard_dbh($myconfig);
fb37acdc Moritz Bunkus
my $query = qq|SELECT curr FROM defaults|;

bea3f989 Moritz Bunkus
my ($curr) = selectrow_query($self, $dbh, $query);
my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr;
fb37acdc Moritz Bunkus
$main::lxdebug->leave_sub();

bea3f989 Moritz Bunkus
return @currencies;
fb37acdc Moritz Bunkus
}

bea3f989 Moritz Bunkus
sub get_default_currency {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;
my @currencies = $self->get_all_currencies($myconfig);

$main::lxdebug->leave_sub();

return $currencies[0];
}
fb37acdc Moritz Bunkus
54e4131e Moritz Bunkus
sub set_payment_options {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $transdate) = @_;

820f3066 Moritz Bunkus
return $main::lxdebug->leave_sub() unless ($self->{payment_id});
54e4131e Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
54e4131e Moritz Bunkus
820f3066 Moritz Bunkus
my $query =
qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long | .
qq|FROM payment_terms p | .
qq|WHERE p.id = ?|;
54e4131e Moritz Bunkus
820f3066 Moritz Bunkus
($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
$self->{payment_terms}) =
selectrow_query($self, $dbh, $query, $self->{payment_id});
54e4131e Moritz Bunkus
820f3066 Moritz Bunkus
if ($transdate eq "") {
if ($self->{invdate}) {
$transdate = $self->{invdate};
} else {
$transdate = $self->{transdate};
566608b7 Philip Reetz
}
820f3066 Moritz Bunkus
}
566608b7 Philip Reetz
820f3066 Moritz Bunkus
$query =
qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | .
qq|FROM payment_terms|;
($self->{netto_date}, $self->{skonto_date}) =
selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});

52ee8da6 Moritz Bunkus
my ($invtotal, $total);
my (%amounts, %formatted_amounts);
54a4321b Moritz Bunkus
52ee8da6 Moritz Bunkus
if ($self->{type} =~ /_order$/) {
$amounts{invtotal} = $self->{ordtotal};
$amounts{total} = $self->{ordtotal};

} elsif ($self->{type} =~ /_quotation$/) {
$amounts{invtotal} = $self->{quototal};
$amounts{total} = $self->{quototal};

} else {
$amounts{invtotal} = $self->{invtotal};
$amounts{total} = $self->{total};
}
6d5d4f24 Bernd Bleßmann
$amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
52ee8da6 Moritz Bunkus
map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;

$amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto};
$amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
$amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto});

7e6d7935 Moritz Bunkus
foreach (keys %amounts) {
$amounts{$_} = $self->round_amount($amounts{$_}, 2);
$formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
}
820f3066 Moritz Bunkus
if ($self->{"language_id"}) {
$query =
qq|SELECT t.description_long, l.output_numberformat, l.output_dateformat, l.output_longdates | .
qq|FROM translation_payment_terms t | .
qq|LEFT JOIN language l ON t.language_id = l.id | .
qq|WHERE (t.language_id = ?) AND (t.payment_terms_id = ?)|;
my ($description_long, $output_numberformat, $output_dateformat,
$output_longdates) =
selectrow_query($self, $dbh, $query,
$self->{"language_id"}, $self->{"payment_id"});

$self->{payment_terms} = $description_long if ($description_long);

if ($output_dateformat) {
foreach my $key (qw(netto_date skonto_date)) {
$self->{$key} =
$main::locale->reformat_date($myconfig, $self->{$key},
$output_dateformat,
$output_longdates);
54a4321b Moritz Bunkus
}
}
54e4131e Moritz Bunkus
820f3066 Moritz Bunkus
if ($output_numberformat &&
($output_numberformat ne $myconfig->{"numberformat"})) {
my $saved_numberformat = $myconfig->{"numberformat"};
$myconfig->{"numberformat"} = $output_numberformat;
52ee8da6 Moritz Bunkus
map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
820f3066 Moritz Bunkus
$myconfig->{"numberformat"} = $saved_numberformat;
}
54e4131e Moritz Bunkus
}

820f3066 Moritz Bunkus
$self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
$self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
$self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
$self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
$self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
$self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
$self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;

52ee8da6 Moritz Bunkus
map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;

6d5d4f24 Bernd Bleßmann
$self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};

54e4131e Moritz Bunkus
$main::lxdebug->leave_sub();

}

sub get_template_language {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my $template_code = "";

if ($self->{language_id}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT template_code FROM language WHERE id = ?|;
($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
54e4131e Moritz Bunkus
}

$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}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
54e4131e Moritz Bunkus
}

$main::lxdebug->leave_sub();

return $template_code;
}

sub get_shipto {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my $template_code = "";

if ($self->{shipto_id}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
map({ $self->{$_} = $ref->{$_} } keys(%$ref));
54e4131e Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

d319704a Moritz Bunkus
sub add_shipto {
$main::lxdebug->enter_sub();

54e4131e Moritz Bunkus
my ($self, $dbh, $id, $module) = @_;
ef17e41a Moritz Bunkus
d319704a Moritz Bunkus
my $shipto;
ef17e41a Moritz Bunkus
my @values;
a5f4490f Philip Reetz
ef17e41a Moritz Bunkus
foreach my $item (qw(name department_1 department_2 street zipcode city country
7f683e50 Jan Büren
contact cp_gender phone fax email)) {
d319704a Moritz Bunkus
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
ef17e41a Moritz Bunkus
push(@values, $self->{"shipto${item}"});
d319704a Moritz Bunkus
}
a5f4490f Philip Reetz
d319704a Moritz Bunkus
if ($shipto) {
54e4131e Moritz Bunkus
if ($self->{shipto_id}) {
ef17e41a Moritz Bunkus
my $query = qq|UPDATE shipto set
shiptoname = ?,
shiptodepartment_1 = ?,
shiptodepartment_2 = ?,
shiptostreet = ?,
shiptozipcode = ?,
shiptocity = ?,
shiptocountry = ?,
shiptocontact = ?,
7f683e50 Jan Büren
shiptocp_gender = ?,
ef17e41a Moritz Bunkus
shiptophone = ?,
shiptofax = ?,
shiptoemail = ?
WHERE shipto_id = ?|;
do_query($self, $dbh, $query, @values, $self->{shipto_id});
54e4131e Moritz Bunkus
} else {
7c3117b5 Thomas Kasulke
my $query = qq|SELECT * FROM shipto
ef17e41a Moritz Bunkus
WHERE shiptoname = ? AND
shiptodepartment_1 = ? AND
shiptodepartment_2 = ? AND
shiptostreet = ? AND
shiptozipcode = ? AND
shiptocity = ? AND
shiptocountry = ? AND
shiptocontact = ? AND
7f683e50 Jan Büren
shiptocp_gender = ? AND
ef17e41a Moritz Bunkus
shiptophone = ? AND
shiptofax = ? AND
a5f4490f Philip Reetz
shiptoemail = ? AND
f54fd660 Sven Schöling
module = ? AND
17b40b38 Philip Reetz
trans_id = ?|;
my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
7c3117b5 Thomas Kasulke
if(!$insert_check){
$query =
ef17e41a Moritz Bunkus
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry,
7f683e50 Jan Büren
shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
ef17e41a Moritz Bunkus
do_query($self, $dbh, $query, $id, @values, $module);
820f3066 Moritz Bunkus
}
54e4131e Moritz Bunkus
}
d319704a Moritz Bunkus
}
ef17e41a Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub get_employee {
$main::lxdebug->enter_sub();

my ($self, $dbh) = @_;

d4b17776 Sven Schöling
$dbh ||= $self->get_standard_dbh(\%main::myconfig);

ef17e41a Moritz Bunkus
my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
16821864 Thomas Kasulke
($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
$self->{"employee_id"} *= 1;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

6c56877d Moritz Bunkus
sub get_employee_data {
afe8a81b Moritz Bunkus
$main::lxdebug->enter_sub();

6c56877d Moritz Bunkus
my $self = shift;
my %params = @_;

Common::check_params(\%params, qw(prefix));
Common::check_params_x(\%params, qw(id));

if (!$params{id}) {
$main::lxdebug->leave_sub();
return;
}
afe8a81b Moritz Bunkus
6c56877d Moritz Bunkus
my $myconfig = \%main::myconfig;
my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig);
09a055b2 Sven Schöling
6c56877d Moritz Bunkus
my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
afe8a81b Moritz Bunkus
if ($login) {
0534e310 Moritz Bunkus
my $user = User->new($login);
6c56877d Moritz Bunkus
map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
0534e310 Moritz Bunkus
6c56877d Moritz Bunkus
$self->{$params{prefix} . '_login'} = $login;
$self->{$params{prefix} . '_name'} ||= $login;
afe8a81b Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

85e36de2 Philip Reetz
sub get_duedate {
$main::lxdebug->enter_sub();

3879426c Moritz Bunkus
my ($self, $myconfig, $reference_date) = @_;
85e36de2 Philip Reetz
2fa5768e Moritz Bunkus
$reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date';
3879426c Moritz Bunkus
2fa5768e Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|;
my ($duedate) = selectrow_query($self, $dbh, $query, $self->{payment_id});
85e36de2 Philip Reetz
$main::lxdebug->leave_sub();
3879426c Moritz Bunkus
return $duedate;
85e36de2 Philip Reetz
}

03c310de Moritz Bunkus
sub _get_contacts {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

15682dc4 Moritz Bunkus
my ($self, $dbh, $id, $key) = @_;
d319704a Moritz Bunkus
15682dc4 Moritz Bunkus
$key = "all_contacts" unless ($key);
d319704a Moritz Bunkus
56ed6467 Moritz Bunkus
if (!$id) {
$self->{$key} = [];
$main::lxdebug->leave_sub();
return;
}

15682dc4 Moritz Bunkus
my $query =
ef17e41a Moritz Bunkus
qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
qq|FROM contacts | .
15682dc4 Moritz Bunkus
qq|WHERE cp_cv_id = ? | .
ef17e41a Moritz Bunkus
qq|ORDER BY lower(cp_name)|;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

03c310de Moritz Bunkus
sub _get_projects {
59f8f1fa Moritz Bunkus
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

my ($all, $old_id, $where, @values);

if (ref($key) eq "HASH") {
my $params = $key;

$key = "ALL_PROJECTS";

foreach my $p (keys(%{$params})) {
if ($p eq "all") {
$all = $params->{$p};
} elsif ($p eq "old_id") {
$old_id = $params->{$p};
} elsif ($p eq "key") {
$key = $params->{$p};
}
}
}

if (!$all) {
$where = "WHERE active ";
if ($old_id) {
cfc6a60d Moritz Bunkus
if (ref($old_id) eq "ARRAY") {
my @ids = grep({ $_ } @{$old_id});
if (@ids) {
$where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
push(@values, @ids);
}
} else {
$where .= " OR (id = ?) ";
push(@values, $old_id);
}
59f8f1fa Moritz Bunkus
}
}

my $query =
qq|SELECT id, projectnumber, description, active | .
qq|FROM project | .
$where .
qq|ORDER BY lower(projectnumber)|;

ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
59f8f1fa Moritz Bunkus
$main::lxdebug->leave_sub();
}

03c310de Moritz Bunkus
sub _get_shipto {
$main::lxdebug->enter_sub();

my ($self, $dbh, $vc_id, $key) = @_;

$key = "all_shipto" unless ($key);

56ed6467 Moritz Bunkus
if ($vc_id) {
# get shipping addresses
my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
03c310de Moritz Bunkus
56ed6467 Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);

} else {
$self->{$key} = [];
}
03c310de Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub _get_printers {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_printers" unless ($key);

b12e8d14 Moritz Bunkus
my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
03c310de Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
03c310de Moritz Bunkus
$main::lxdebug->leave_sub();
}

913fe339 Moritz Bunkus
sub _get_charts {
$main::lxdebug->enter_sub();

my ($self, $dbh, $params) = @_;
d71bfc9b Sven Schöling
my ($key);
913fe339 Moritz Bunkus
$key = $params->{key};
$key = "all_charts" unless ($key);

my $transdate = quote_db_date($params->{transdate});

my $query =
12fb1a28 Jan Büren
qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
913fe339 Moritz Bunkus
qq|FROM chart c | .
qq|LEFT JOIN taxkeys tk ON | .
qq|(tk.id = (SELECT id FROM taxkeys | .
qq| WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
qq| ORDER BY startdate DESC LIMIT 1)) | .
qq|ORDER BY c.accno|;

ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
913fe339 Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub _get_taxcharts {
$main::lxdebug->enter_sub();

797ad4c5 Moritz Bunkus
my ($self, $dbh, $params) = @_;

my $key = "all_taxcharts";
my @where;

if (ref $params eq 'HASH') {
$key = $params->{key} if ($params->{key});
if ($params->{module} eq 'AR') {
push @where, 'taxkey NOT IN (8, 9, 18, 19)';

} elsif ($params->{module} eq 'AP') {
push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)';
}

} elsif ($params) {
$key = $params;
}
913fe339 Moritz Bunkus
797ad4c5 Moritz Bunkus
my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where);
913fe339 Moritz Bunkus
797ad4c5 Moritz Bunkus
my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
913fe339 Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
913fe339 Moritz Bunkus
$main::lxdebug->leave_sub();
}

ddbe3ea5 Moritz Bunkus
sub _get_taxzones {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_taxzones" unless ($key);

my $query = qq|SELECT * FROM tax_zones ORDER BY id|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

a751b16c Moritz Bunkus
sub _get_employees {
$main::lxdebug->enter_sub();

03daa77e Moritz Bunkus
my ($self, $dbh, $default_key, $key) = @_;
a751b16c Moritz Bunkus
03daa77e Moritz Bunkus
$key = $default_key unless ($key);
8c7e4493 Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|);
16821864 Thomas Kasulke
$main::lxdebug->leave_sub();
}

9fa58e1b Moritz Bunkus
sub _get_business_types {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

6d169764 Moritz Bunkus
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_business_types";
my $where = '';

if (exists $options->{salesman}) {
$where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
}

$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
9fa58e1b Moritz Bunkus
$main::lxdebug->leave_sub();
}

b12e8d14 Moritz Bunkus
sub _get_languages {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_languages" unless ($key);

my $query = qq|SELECT * FROM language ORDER BY id|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

b4089f8d Moritz Bunkus
sub _get_dunning_configs {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_dunning_configs" unless ($key);

my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

aa8ce6f5 Thomas Kasulke
sub _get_currencies {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_currencies" unless ($key);

my $query = qq|SELECT curr AS currency FROM defaults|;
f54fd660 Sven Schöling
ee9fb352 Thomas Kasulke
$self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})];
aa8ce6f5 Thomas Kasulke
$main::lxdebug->leave_sub();
}

f6fa032d Thomas Kasulke
sub _get_payments {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_payments" unless ($key);

my $query = qq|SELECT * FROM payment_terms ORDER BY id|;
f54fd660 Sven Schöling
f6fa032d Thomas Kasulke
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

a5d5620d Thomas Kasulke
sub _get_customers {
$main::lxdebug->enter_sub();

9d60642b Moritz Bunkus
my ($self, $dbh, $key) = @_;
a5d5620d Thomas Kasulke
9d60642b Moritz Bunkus
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
my $limit_clause = "LIMIT $options->{limit}" if $options->{limit};
a5d5620d Thomas Kasulke
0bf218ff Moritz Bunkus
my @where;
push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman};
push @where, qq|NOT obsolete| if !$options->{with_obsolete};
my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';

my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
9d60642b Moritz Bunkus
$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
a5d5620d Thomas Kasulke
$main::lxdebug->leave_sub();
}

86b09030 Thomas Kasulke
sub _get_vendors {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_vendors" unless ($key);

a5501b16 Moritz Bunkus
my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
86b09030 Thomas Kasulke
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

2c5603bb Moritz Bunkus
sub _get_departments {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_departments" unless ($key);

03daa77e Moritz Bunkus
my $query = qq|SELECT * FROM department ORDER BY description|;
2c5603bb Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

8c7e4493 Moritz Bunkus
sub _get_warehouses {
1e251313 Moritz Bunkus
$main::lxdebug->enter_sub();

8c7e4493 Moritz Bunkus
my ($self, $dbh, $param) = @_;

696aad9c Moritz Bunkus
my ($key, $bins_key);
1e251313 Moritz Bunkus
8c7e4493 Moritz Bunkus
if ('' eq ref $param) {
$key = $param;
696aad9c Moritz Bunkus
8c7e4493 Moritz Bunkus
} else {
$key = $param->{key};
$bins_key = $param->{bins};
}

my $query = qq|SELECT w.* FROM warehouse w
WHERE (NOT w.invalid) AND
((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
ORDER BY w.sortkey|;

696aad9c Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
1e251313 Moritz Bunkus
8c7e4493 Moritz Bunkus
if ($bins_key) {
$query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|;
my $sth = prepare_query($self, $dbh, $query);

foreach my $warehouse (@{ $self->{$key} }) {
do_statement($self, $sth, $query, $warehouse->{id});
$warehouse->{$bins_key} = [];

while (my $ref = $sth->fetchrow_hashref()) {
push @{ $warehouse->{$bins_key} }, $ref;
}
}
$sth->finish();
}

$main::lxdebug->leave_sub();
}

sub _get_simple {
$main::lxdebug->enter_sub();

my ($self, $dbh, $table, $key, $sortkey) = @_;

my $query = qq|SELECT * FROM $table|;
$query .= qq| ORDER BY $sortkey| if ($sortkey);
1e251313 Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

d71bfc9b Sven Schöling
#sub _get_groups {
# $main::lxdebug->enter_sub();
#
# my ($self, $dbh, $key) = @_;
#
# $key ||= "all_groups";
#
# my $groups = $main::auth->read_groups();
#
# $self->{$key} = selectall_hashref_query($self, $dbh, $query);
#
# $main::lxdebug->leave_sub();
#}
7a7f33b5 Moritz Bunkus
15682dc4 Moritz Bunkus
sub get_lists {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

15682dc4 Moritz Bunkus
my $self = shift;
my %params = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh(\%main::myconfig);
15682dc4 Moritz Bunkus
my ($sth, $query, $ref);
d319704a Moritz Bunkus
15682dc4 Moritz Bunkus
my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor";
my $vc_id = $self->{"${vc}_id"};
d319704a Moritz Bunkus
15682dc4 Moritz Bunkus
if ($params{"contacts"}) {
03c310de Moritz Bunkus
$self->_get_contacts($dbh, $vc_id, $params{"contacts"});
d319704a Moritz Bunkus
}

15682dc4 Moritz Bunkus
if ($params{"shipto"}) {
03c310de Moritz Bunkus
$self->_get_shipto($dbh, $vc_id, $params{"shipto"});
d319704a Moritz Bunkus
}
15682dc4 Moritz Bunkus
59f8f1fa Moritz Bunkus
if ($params{"projects"} || $params{"all_projects"}) {
03c310de Moritz Bunkus
$self->_get_projects($dbh, $params{"all_projects"} ?
$params{"all_projects"} : $params{"projects"},
$params{"all_projects"} ? 1 : 0);
59f8f1fa Moritz Bunkus
}

1b3fe156 Sven Schöling
if ($params{"printers"}) {
03c310de Moritz Bunkus
$self->_get_printers($dbh, $params{"printers"});
1b3fe156 Sven Schöling
}

b12e8d14 Moritz Bunkus
if ($params{"languages"}) {
$self->_get_languages($dbh, $params{"languages"});
}

913fe339 Moritz Bunkus
if ($params{"charts"}) {
$self->_get_charts($dbh, $params{"charts"});
}

if ($params{"taxcharts"}) {
$self->_get_taxcharts($dbh, $params{"taxcharts"});
}

ddbe3ea5 Moritz Bunkus
if ($params{"taxzones"}) {
$self->_get_taxzones($dbh, $params{"taxzones"});
}

a751b16c Moritz Bunkus
if ($params{"employees"}) {
03daa77e Moritz Bunkus
$self->_get_employees($dbh, "all_employees", $params{"employees"});
a751b16c Moritz Bunkus
}
f54fd660 Sven Schöling
16821864 Thomas Kasulke
if ($params{"salesmen"}) {
03daa77e Moritz Bunkus
$self->_get_employees($dbh, "all_salesmen", $params{"salesmen"});
16821864 Thomas Kasulke
}
a751b16c Moritz Bunkus
9fa58e1b Moritz Bunkus
if ($params{"business_types"}) {
$self->_get_business_types($dbh, $params{"business_types"});
}

b4089f8d Moritz Bunkus
if ($params{"dunning_configs"}) {
$self->_get_dunning_configs($dbh, $params{"dunning_configs"});
}
f54fd660 Sven Schöling
aa8ce6f5 Thomas Kasulke
if($params{"currencies"}) {
$self->_get_currencies($dbh, $params{"currencies"});
}
f54fd660 Sven Schöling
a5d5620d Thomas Kasulke
if($params{"customers"}) {
9d60642b Moritz Bunkus
$self->_get_customers($dbh, $params{"customers"});
a5d5620d Thomas Kasulke
}
f54fd660 Sven Schöling
86b09030 Thomas Kasulke
if($params{"vendors"}) {
b6dc5623 Sven Schöling
if (ref $params{"vendors"} eq 'HASH') {
$self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
} else {
$self->_get_vendors($dbh, $params{"vendors"});
}
86b09030 Thomas Kasulke
}
f54fd660 Sven Schöling
f6fa032d Thomas Kasulke
if($params{"payments"}) {
$self->_get_payments($dbh, $params{"payments"});
}
b4089f8d Moritz Bunkus
2c5603bb Moritz Bunkus
if($params{"departments"}) {
$self->_get_departments($dbh, $params{"departments"});
}

1e251313 Moritz Bunkus
if ($params{price_factors}) {
8c7e4493 Moritz Bunkus
$self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
}

if ($params{warehouses}) {
$self->_get_warehouses($dbh, $params{warehouses});
7a7f33b5 Moritz Bunkus
}

d71bfc9b Sven Schöling
# if ($params{groups}) {
# $self->_get_groups($dbh, $params{groups});
# }

2740f3f0 Sven Schöling
if ($params{partsgroup}) {
$self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
}
1e251313 Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# this sub gets the id and name from $table
sub get_name {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $table) = @_;

# connect to database
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$table = $table eq "customer" ? "customer" : "vendor";
my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my ($query, @values);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
if (!$self->{openinvoices}) {
my $where;
if ($self->{customernumber} ne "") {
$where = qq|(vc.customernumber ILIKE ?)|;
push(@values, '%' . $self->{customernumber} . '%');
} else {
$where = qq|(vc.name ILIKE ?)|;
push(@values, '%' . $self->{$table} . '%');
}
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$query =
qq~SELECT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $table vc
WHERE $where AND (NOT vc.obsolete)
ORDER BY vc.name~;
} else {
$query =
qq~SELECT DISTINCT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $arap a
JOIN $table vc ON (a.${table}_id = vc.id)
WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
ORDER BY vc.name~;
push(@values, '%' . $self->{$table} . '%');
d319704a Moritz Bunkus
}
ef17e41a Moritz Bunkus
$self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

ef17e41a Moritz Bunkus
return scalar(@{ $self->{name_list} });
d319704a Moritz Bunkus
}

# the selection sub is used in the AR, AP, IS, IR and OE module
#
sub all_vc {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $table, $module) = @_;

my $ref;
9933c636 Sven Schöling
my $dbh = $self->get_standard_dbh;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$table = $table eq "customer" ? "customer" : "vendor";

d319704a Moritz Bunkus
my $query = qq|SELECT count(*) FROM $table|;
ef17e41a Moritz Bunkus
my ($count) = selectrow_query($self, $dbh, $query);
d319704a Moritz Bunkus
# build selection list
3702484c Sven Schöling
if ($count <= $myconfig->{vclimit}) {
2ff471a7 Moritz Bunkus
$query = qq|SELECT id, name, salesman_id
ef17e41a Moritz Bunkus
FROM $table WHERE NOT obsolete
ORDER BY name|;
$self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
}

# get self
$self->get_employee($dbh);

# setup sales contacts
$query = qq|SELECT e.id, e.name
ef17e41a Moritz Bunkus
FROM employee e
WHERE (e.sales = '1') AND (NOT e.id = ?)|;
$self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
d319704a Moritz Bunkus
# this is for self
ef17e41a Moritz Bunkus
push(@{ $self->{all_employees} },
{ id => $self->{employee_id},
name => $self->{employee} });
d319704a Moritz Bunkus
# sort the whole thing
@{ $self->{all_employees} } =
sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };

if ($module eq 'AR') {

# prepare query for departments
ef17e41a Moritz Bunkus
$query = qq|SELECT id, description
FROM department
WHERE role = 'P'
ORDER BY description|;
d319704a Moritz Bunkus
} else {
ef17e41a Moritz Bunkus
$query = qq|SELECT id, description
FROM department
ORDER BY description|;
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
$self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
54e4131e Moritz Bunkus
# get languages
$query = qq|SELECT id, description
FROM language
ef17e41a Moritz Bunkus
ORDER BY id|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{languages} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get printer
$query = qq|SELECT printer_description, id
FROM printers
ef17e41a Moritz Bunkus
ORDER BY printer_description|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{printers} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get payment terms
$query = qq|SELECT id, description
FROM payment_terms
828bd683 Moritz Bunkus
ORDER BY sortkey|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);

54e4131e Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub language_payment {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
54e4131e Moritz Bunkus
# get languages
my $query = qq|SELECT id, description
ef17e41a Moritz Bunkus
FROM language
ORDER BY id|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{languages} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get printer
$query = qq|SELECT printer_description, id
FROM printers
ef17e41a Moritz Bunkus
ORDER BY printer_description|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{printers} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get payment terms
$query = qq|SELECT id, description
FROM payment_terms
828bd683 Moritz Bunkus
ORDER BY sortkey|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get buchungsgruppen
$query = qq|SELECT id, description
FROM buchungsgruppen|;

ef17e41a Moritz Bunkus
$self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# this is only used for reports
sub all_departments {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $table) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $where;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
if ($table eq 'customer') {
$where = "WHERE role = 'P' ";
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
my $query = qq|SELECT id, description
FROM department
$where
ORDER BY description|;
$self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
e2b9e173 Sven Schöling
delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub create_links {
$main::lxdebug->enter_sub();

f36eb9fc Moritz Bunkus
my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my ($fld, $arap);
if ($table eq "customer") {
$fld = "buy";
$arap = "ar";
} else {
$table = "vendor";
$fld = "sell";
$arap = "ap";
}

d319704a Moritz Bunkus
$self->all_vc($myconfig, $table, $module);

# get last customers or vendors
ef17e41a Moritz Bunkus
my ($query, $sth, $ref);
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
my %xkeyref = ();

53beea8b Philip Reetz
if (!$self->{id}) {
d319704a Moritz Bunkus
53beea8b Philip Reetz
my $transdate = "current_date";
if ($self->{transdate}) {
ef17e41a Moritz Bunkus
$transdate = $dbh->quote($self->{transdate});
53beea8b Philip Reetz
}
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# 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
ef17e41a Moritz Bunkus
WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
(SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
53beea8b Philip Reetz
ORDER BY c.accno|;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$sth = $dbh->prepare($query);
fbe66f59 Udo Spallek
98ad02ca Moritz Bunkus
do_statement($self, $sth, $query, '%' . $module . '%');
fbe66f59 Udo Spallek
53beea8b Philip Reetz
$self->{accounts} = "";
d71bfc9b Sven Schöling
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
ef17e41a Moritz Bunkus
97d71ce1 Moritz Bunkus
foreach my $key (split(/:/, $ref->{link})) {
5cf977e5 Moritz Bunkus
if ($key =~ /\Q$module\E/) {
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
d319704a Moritz Bunkus
}
}
}

54e4131e Moritz Bunkus
# get taxkeys and description
97c05a9f Sven Schöling
$query = qq|SELECT id, taxkey, taxdescription FROM tax|;
98ad02ca Moritz Bunkus
$self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
if (($module eq "AP") || ($module eq "AR")) {
# get tax rates and description
ef17e41a Moritz Bunkus
$query = qq|SELECT * FROM tax|;
98ad02ca Moritz Bunkus
$self->{TAX} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
}

if ($self->{id}) {
ef17e41a Moritz Bunkus
$query =
qq|SELECT
a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid,
a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
a.intnotes, a.department_id, a.amount AS oldinvtotal,
a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
c.name AS $table,
d.description AS department,
e.name AS employee
FROM $arap a
a0f1b420 Moritz Bunkus
JOIN $table c ON (a.${table}_id = c.id)
ef17e41a Moritz Bunkus
LEFT JOIN employee e ON (e.id = a.employee_id)
LEFT JOIN department d ON (d.id = a.department_id)
WHERE a.id = ?|;
$ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
d319704a Moritz Bunkus
d71bfc9b Sven Schöling
foreach my $key (keys %$ref) {
d319704a Moritz Bunkus
$self->{$key} = $ref->{$key};
}
53beea8b Philip Reetz
my $transdate = "current_date";
if ($self->{transdate}) {
ef17e41a Moritz Bunkus
$transdate = $dbh->quote($self->{transdate});
53beea8b Philip Reetz
}
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# now get the account numbers
b49779f0 Moritz Bunkus
$query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
FROM chart c
LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
WHERE c.link LIKE ?
AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
1aa5ac26 Philip Reetz
OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
b49779f0 Moritz Bunkus
ORDER BY c.accno|;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$sth = $dbh->prepare($query);
c8d21015 Sven Schöling
do_statement($self, $sth, $query, "%$module%");
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} = "";
d71bfc9b Sven Schöling
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
ef17e41a Moritz Bunkus
97d71ce1 Moritz Bunkus
foreach my $key (split(/:/, $ref->{link})) {
5cf977e5 Moritz Bunkus
if ($key =~ /\Q$module\E/) {
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
}
}


d319704a Moritz Bunkus
# get amounts from individual entries
ef17e41a Moritz Bunkus
$query =
qq|SELECT
1c084510 Moritz Bunkus
c.accno, c.description,
ef17e41a Moritz Bunkus
a.source, a.amount, a.memo, a.transdate, a.cleared, a.project_id, a.taxkey,
p.projectnumber,
t.rate, t.id
FROM acc_trans a
LEFT JOIN chart c ON (c.id = a.chart_id)
LEFT JOIN project p ON (p.id = a.project_id)
LEFT JOIN tax t ON (t.id= (SELECT tk.tax_id FROM taxkeys tk
WHERE (tk.taxkey_id=a.taxkey) AND
((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id = a.taxkey)
THEN tk.chart_id = a.chart_id
ELSE 1 = 1
END)
OR (c.link='%tax%')) AND
(startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1))
WHERE a.trans_id = ?
AND a.fx_transaction = '0'
6ff01fdb Moritz Bunkus
ORDER BY a.acc_trans_id, a.transdate|;
d319704a Moritz Bunkus
$sth = $dbh->prepare($query);
98ad02ca Moritz Bunkus
do_statement($self, $sth, $query, $self->{id});
d319704a Moritz Bunkus
# get exchangerate for currency
$self->{exchangerate} =
ef17e41a Moritz Bunkus
$self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
081a4f97 Moritz Bunkus
my $index = 0;
d319704a Moritz Bunkus
# store amounts in {acc_trans}{$key} for multiple accounts
d71bfc9b Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
d319704a Moritz Bunkus
$ref->{exchangerate} =
ef17e41a Moritz Bunkus
$self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
081a4f97 Moritz Bunkus
if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
de651621 Stephan Köhler
$index++;
}
54e4131e Moritz Bunkus
if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
$ref->{amount} *= -1;
}
de651621 Stephan Köhler
$ref->{index} = $index;
d319704a Moritz Bunkus
push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
}

53beea8b Philip Reetz
$sth->finish;
ef17e41a Moritz Bunkus
$query =
qq|SELECT
d.curr AS currencies, d.closedto, d.revtrans,
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
(SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
map { $self->{$_} = $ref->{$_} } keys %$ref;

} else {

# get date
ef17e41a Moritz Bunkus
$query =
qq|SELECT
current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans,
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
(SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
map { $self->{$_} = $ref->{$_} } keys %$ref;

if ($self->{"$self->{vc}_id"}) {

# only setup currency
97d71ce1 Moritz Bunkus
($self->{currency}) = split(/:/, $self->{currencies});
d319704a Moritz Bunkus
} else {

$self->lastname_used($dbh, $myconfig, $table, $module);

# get exchangerate for currency
$self->{exchangerate} =
ef17e41a Moritz Bunkus
$self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
d319704a Moritz Bunkus
}

}

$main::lxdebug->leave_sub();
}

sub lastname_used {
$main::lxdebug->enter_sub();

my ($self, $dbh, $myconfig, $table, $module) = @_;

556a2137 Moritz Bunkus
my ($arap, $where);

$table = $table eq "customer" ? "customer" : "vendor";
my %column_map = ("a.curr" => "currency",
"a.${table}_id" => "${table}_id",
"a.department_id" => "department_id",
"d.description" => "department",
"ct.name" => $table,
"current_date + ct.terms" => "duedate",
);

if ($self->{type} =~ /delivery_order/) {
$arap = 'delivery_orders';
delete $column_map{"a.curr"};
d319704a Moritz Bunkus
556a2137 Moritz Bunkus
} elsif ($self->{type} =~ /_order/) {
d319704a Moritz Bunkus
$arap = 'oe';
$where = "quotation = '0'";
556a2137 Moritz Bunkus
} elsif ($self->{type} =~ /_quotation/) {
d319704a Moritz Bunkus
$arap = 'oe';
$where = "quotation = '1'";
556a2137 Moritz Bunkus
} elsif ($table eq 'customer') {
$arap = 'ar';

} else {
$arap = 'ap';

d319704a Moritz Bunkus
}

556a2137 Moritz Bunkus
$where = "($where) AND" if ($where);
my $query = qq|SELECT MAX(id) FROM $arap
WHERE $where ${table}_id > 0|;
my ($trans_id) = selectrow_query($self, $dbh, $query);
$trans_id *= 1;
d319704a Moritz Bunkus
556a2137 Moritz Bunkus
my $column_spec = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
$query = qq|SELECT $column_spec
FROM $arap a
LEFT JOIN $table ct ON (a.${table}_id = ct.id)
LEFT JOIN department d ON (a.department_id = d.id)
WHERE a.id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id);

map { $self->{$_} = $ref->{$_} } values %column_map;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub current_date {
$main::lxdebug->enter_sub();

f88cdcc7 Sven Schöling
my $self = shift;
my $myconfig = shift || \%::myconfig;
8001c18b Sven Schöling
my ($thisdate, $days) = @_;
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query;
d319704a Moritz Bunkus
$days *= 1;
if ($thisdate) {
my $dateformat = $myconfig->{dateformat};
$dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
ef17e41a Moritz Bunkus
$thisdate = $dbh->quote($thisdate);
$query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
d319704a Moritz Bunkus
} else {
ef17e41a Moritz Bunkus
$query = qq|SELECT current_date AS thisdate|;
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
($thisdate) = selectrow_query($self, $dbh, $query);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $thisdate;
}

sub like {
$main::lxdebug->enter_sub();

my ($self, $string) = @_;

if ($string !~ /%/) {
$string = "%$string%";
}

$string =~ s/\'/\'\'/g;

$main::lxdebug->leave_sub();

return $string;
}

sub redo_rows {
$main::lxdebug->enter_sub();

my ($self, $flds, $new, $count, $numrows) = @_;

my @ndx = ();

29795499 Sven Schöling
map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
d319704a Moritz Bunkus
my $i = 0;

# fill rows
foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
$i++;
d71bfc9b Sven Schöling
my $j = $item->{ndx} - 1;
d319704a Moritz Bunkus
map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
}

# delete empty rows
for $i ($count + 1 .. $numrows) {
map { delete $self->{"${_}_$i"} } @{$flds};
}

$main::lxdebug->leave_sub();
}

sub update_status {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my ($i, $id);

my $dbh = $self->dbconnect_noauto($myconfig);

my $query = qq|DELETE FROM status
ef17e41a Moritz Bunkus
WHERE (formname = ?) AND (trans_id = ?)|;
my $sth = prepare_query($self, $dbh, $query);
d319704a Moritz Bunkus
if ($self->{formname} =~ /(check|receipt)/) {
for $i (1 .. $self->{rowcount}) {
ef17e41a Moritz Bunkus
do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
d319704a Moritz Bunkus
}
} else {
ef17e41a Moritz Bunkus
do_statement($self, $sth, $query, $self->{formname}, $self->{id});
d319704a Moritz Bunkus
}
ef17e41a Moritz Bunkus
$sth->finish();
d319704a Moritz Bunkus
5cf977e5 Moritz Bunkus
my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
my %queued = split / /, $self->{queued};
ef17e41a Moritz Bunkus
my @values;
d319704a Moritz Bunkus
if ($self->{formname} =~ /(check|receipt)/) {

# this is a check or receipt, add one entry for each lineitem
my ($accno) = split /--/, $self->{account};
ef17e41a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
@values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
$sth = prepare_query($self, $dbh, $query);
d319704a Moritz Bunkus
for $i (1 .. $self->{rowcount}) {
if ($self->{"checked_$i"}) {
ef17e41a Moritz Bunkus
do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
d319704a Moritz Bunkus
}
}
ef17e41a Moritz Bunkus
$sth->finish();

d319704a Moritz Bunkus
} else {
ef17e41a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
$queued{$self->{formname}}, $self->{formname});
d319704a Moritz Bunkus
}

$dbh->commit;
$dbh->disconnect;

$main::lxdebug->leave_sub();
}

sub save_status {
$main::lxdebug->enter_sub();

my ($self, $dbh) = @_;

my ($query, $printed, $emailed);

my $formnames = $self->{printed};
my $emailforms = $self->{emailed};

29795499 Sven Schöling
$query = qq|DELETE FROM status
ef17e41a Moritz Bunkus
WHERE (formname = ?) AND (trans_id = ?)|;
do_query($self, $dbh, $query, $self->{formname}, $self->{id});
d319704a Moritz Bunkus
# this only applies to the forms
# checks and receipts are posted when printed or queued

if ($self->{queued}) {
my %queued = split / /, $self->{queued};

foreach my $formname (keys %queued) {
5cf977e5 Moritz Bunkus
$printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
d319704a Moritz Bunkus
5cf977e5 Moritz Bunkus
$formnames =~ s/\Q$self->{formname}\E//;
$emailforms =~ s/\Q$self->{formname}\E//;
d319704a Moritz Bunkus
}
}

# save printed, emailed info
$formnames =~ s/^ +//g;
$emailforms =~ s/^ +//g;

my %status = ();
map { $status{$_}{printed} = 1 } split / +/, $formnames;
map { $status{$_}{emailed} = 1 } split / +/, $emailforms;

foreach my $formname (keys %status) {
5cf977e5 Moritz Bunkus
$printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
ef17e41a Moritz Bunkus
VALUES (?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

ef17e41a Moritz Bunkus
#--- 4 locale ---#
# $main::locale->text('SAVED')
# $main::locale->text('DELETED')
# $main::locale->text('ADDED')
# $main::locale->text('PAYMENT POSTED')
# $main::locale->text('POSTED')
# $main::locale->text('POSTED AS NEW')
# $main::locale->text('ELSE')
# $main::locale->text('SAVED FOR DUNNING')
# $main::locale->text('DUNNING STARTED')
# $main::locale->text('PRINTED')
# $main::locale->text('MAILED')
# $main::locale->text('SCREENED')
f8f101f3 Thomas Kasulke
# $main::locale->text('CANCELED')
ef17e41a Moritz Bunkus
# $main::locale->text('invoice')
# $main::locale->text('proforma')
# $main::locale->text('sales_order')
# $main::locale->text('pick_list')
# $main::locale->text('purchase_order')
# $main::locale->text('bin_list')
# $main::locale->text('sales_quotation')
# $main::locale->text('request_quotation')

sub save_history {
$main::lxdebug->enter_sub();

a590a651 Sven Schöling
my $self = shift;
my $dbh = shift || $self->get_standard_dbh;
ef17e41a Moritz Bunkus
if(!exists $self->{employee_id}) {
&get_employee($self, $dbh);
}

820f3066 Moritz Bunkus
my $query =
e7367fb5 Thomas Kasulke
qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
820f3066 Moritz Bunkus
my @values = (conv_i($self->{id}), $self->{login},
$self->{addition}, $self->{what_done}, "$self->{snumbers}");
do_query($self, $dbh, $query, @values);
ef17e41a Moritz Bunkus
a590a651 Sven Schöling
$dbh->commit;

ef17e41a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub get_history {
$main::lxdebug->enter_sub();

73f6453e Thomas Kasulke
my ($self, $dbh, $trans_id, $restriction, $order) = @_;
my ($orderBy, $desc) = split(/\-\-/, $order);
$order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
ef17e41a Moritz Bunkus
my @tempArray;
my $i = 0;
if ($trans_id ne "") {
my $query =
e077b319 Thomas Kasulke
qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | .
ef17e41a Moritz Bunkus
qq|FROM history_erp h | .
qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
7dd95f35 Moritz Bunkus
qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
$order;
f54fd660 Sven Schöling
ef17e41a Moritz Bunkus
my $sth = $dbh->prepare($query) || $self->dberror($query);

41a03969 Thomas Kasulke
$sth->execute() || $self->dberror("$query");
ef17e41a Moritz Bunkus
while(my $hash_ref = $sth->fetchrow_hashref()) {
$hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
$hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
e077b319 Thomas Kasulke
$hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
ef17e41a Moritz Bunkus
$tempArray[$i++] = $hash_ref;
}
f54fd660 Sven Schöling
$main::lxdebug->leave_sub() and return \@tempArray
ef17e41a Moritz Bunkus
if ($i > 0 && $tempArray[0] ne "");
}
$main::lxdebug->leave_sub();
return 0;
}

d319704a Moritz Bunkus
sub update_defaults {
$main::lxdebug->enter_sub();

7712480e Moritz Bunkus
my ($self, $myconfig, $fld, $provided_dbh) = @_;
d319704a Moritz Bunkus
7712480e Moritz Bunkus
my $dbh;
if ($provided_dbh) {
$dbh = $provided_dbh;
} else {
$dbh = $self->dbconnect_noauto($myconfig);
}
d319704a Moritz Bunkus
my $query = qq|SELECT $fld FROM defaults FOR UPDATE|;
my $sth = $dbh->prepare($query);

$sth->execute || $self->dberror($query);
my ($var) = $sth->fetchrow_array;
$sth->finish;

dcab2b89 Moritz Bunkus
if ($var =~ m/\d+$/) {
my $new_var = (substr $var, $-[0]) * 1 + 1;
my $len_diff = length($var) - $-[0] - length($new_var);
$var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;

} else {
$var = $var . '1';
}
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$query = qq|UPDATE defaults SET $fld = ?|;
do_query($self, $dbh, $query, $var);
d319704a Moritz Bunkus
7712480e Moritz Bunkus
if (!$provided_dbh) {
$dbh->commit;
$dbh->disconnect;
}
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $var;
}

sub update_business {
$main::lxdebug->enter_sub();

93a4e424 Moritz Bunkus
my ($self, $myconfig, $business_id, $provided_dbh) = @_;
d319704a Moritz Bunkus
93a4e424 Moritz Bunkus
my $dbh;
if ($provided_dbh) {
$dbh = $provided_dbh;
} else {
$dbh = $self->dbconnect_noauto($myconfig);
}
d319704a Moritz Bunkus
my $query =
ef17e41a Moritz Bunkus
qq|SELECT customernumberinit FROM business
WHERE id = ? FOR UPDATE|;
my ($var) = selectrow_query($self, $dbh, $query, $business_id);
d319704a Moritz Bunkus
cbcbf5fa Sven Schöling
return undef unless $var;

dcab2b89 Moritz Bunkus
if ($var =~ m/\d+$/) {
my $new_var = (substr $var, $-[0]) * 1 + 1;
my $len_diff = length($var) - $-[0] - length($new_var);
$var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;

} else {
$var = $var . '1';
}

d319704a Moritz Bunkus
$query = qq|UPDATE business
ef17e41a Moritz Bunkus
SET customernumberinit = ?
WHERE id = ?|;
do_query($self, $dbh, $query, $var, $business_id);
d319704a Moritz Bunkus
93a4e424 Moritz Bunkus
if (!$provided_dbh) {
$dbh->commit;
$dbh->disconnect;
}
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $var;
}

sub get_partsgroup {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $p) = @_;
2740f3f0 Sven Schöling
my $target = $p->{target} || 'all_partsgroup';
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
FROM partsgroup pg
ef17e41a Moritz Bunkus
JOIN parts p ON (p.partsgroup_id = pg.id) |;
my @values;
d319704a Moritz Bunkus
if ($p->{searchitems} eq 'part') {
ef17e41a Moritz Bunkus
$query .= qq|WHERE p.inventory_accno_id > 0|;
d319704a Moritz Bunkus
}
if ($p->{searchitems} eq 'service') {
ef17e41a Moritz Bunkus
$query .= qq|WHERE p.inventory_accno_id IS NULL|;
d319704a Moritz Bunkus
}
if ($p->{searchitems} eq 'assembly') {
ef17e41a Moritz Bunkus
$query .= qq|WHERE p.assembly = '1'|;
d319704a Moritz Bunkus
}
if ($p->{searchitems} eq 'labor') {
ef17e41a Moritz Bunkus
$query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|;
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
$query .= qq|ORDER BY partsgroup|;
d319704a Moritz Bunkus
if ($p->{all}) {
$query = qq|SELECT id, partsgroup FROM partsgroup
ORDER BY partsgroup|;
}

if ($p->{language_code}) {
$query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
ef17e41a Moritz Bunkus
t.description AS translation
d319704a Moritz Bunkus
FROM partsgroup pg
ef17e41a Moritz Bunkus
JOIN parts p ON (p.partsgroup_id = pg.id)
LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
ORDER BY translation|;
@values = ($p->{language_code});
d319704a Moritz Bunkus
}

2740f3f0 Sven Schöling
$self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

07d71c33 Stephan Köhler
sub get_pricegroup {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $p) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
07d71c33 Stephan Köhler
my $query = qq|SELECT p.id, p.pricegroup
FROM pricegroup p|;

ef17e41a Moritz Bunkus
$query .= qq| ORDER BY pricegroup|;
07d71c33 Stephan Köhler
if ($p->{all}) {
$query = qq|SELECT id, pricegroup FROM pricegroup
ORDER BY pricegroup|;
}

ef17e41a Moritz Bunkus
$self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
07d71c33 Stephan Köhler
$main::lxdebug->leave_sub();
}

7848e9c8 Udo Spallek
sub all_years {
# usage $form->all_years($myconfig, [$dbh])
# return list of all years where bookings found
# (@all_years)

$main::lxdebug->enter_sub();

my ($self, $myconfig, $dbh) = @_;
ef17e41a Moritz Bunkus
820f3066 Moritz Bunkus
$dbh ||= $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
7848e9c8 Udo Spallek
# get years
my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
ef17e41a Moritz Bunkus
(SELECT MAX(transdate) FROM acc_trans)|;
my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
7848e9c8 Udo Spallek
if ($myconfig->{dateformat} =~ /^yy/) {
($startdate) = split /\W/, $startdate;
($enddate) = split /\W/, $enddate;
ef17e41a Moritz Bunkus
} else {
7848e9c8 Udo Spallek
(@_) = split /\W/, $startdate;
$startdate = $_[2];
(@_) = split /\W/, $enddate;
ef17e41a Moritz Bunkus
$enddate = $_[2];
7848e9c8 Udo Spallek
}

my @all_years;
$startdate = substr($startdate,0,4);
$enddate = substr($enddate,0,4);
ef17e41a Moritz Bunkus
7848e9c8 Udo Spallek
while ($enddate >= $startdate) {
push @all_years, $enddate--;
}

return @all_years;

$main::lxdebug->leave_sub();
}

d7420ba8 Sven Schöling
sub backup_vars {
$main::lxdebug->enter_sub();
my $self = shift;
my @vars = @_;

17a8e2bb Moritz Bunkus
map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
d7420ba8 Sven Schöling
$main::lxdebug->leave_sub();
}

sub restore_vars {
$main::lxdebug->enter_sub();

my $self = shift;
my @vars = @_;

17a8e2bb Moritz Bunkus
map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
d7420ba8 Sven Schöling
$main::lxdebug->leave_sub();
}

d319704a Moritz Bunkus
1;
66022cbd Sven Schöling
__END__

=head1 NAME

SL::Form.pm - main data object.

=head1 SYNOPSIS

This is the main data object of Lx-Office.
Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
Points of interest for a beginner are:

- $form->error - renders a generic error in html. accepts an error message
- $form->get_standard_dbh - returns a database connection for the

=head1 SPECIAL FUNCTIONS

4edf06e5 Sven Schöling
=head2 C<_store_value()>
66022cbd Sven Schöling
parses a complex var name, and stores it in the form.

syntax:
$form->_store_value($key, $value);

keys must start with a string, and can contain various tokens.
supported key structures are:

1. simple access
simple key strings work as expected

id => $form->{id}

2. hash access.
separating two keys by a dot (.) will result in a hash lookup for the inner value
this is similar to the behaviour of java and templating mechanisms.

filter.description => $form->{filter}->{description}

3. array+hashref access

adding brackets ([]) before the dot will cause the next hash to be put into an array.
using [+] instead of [] will force a new array index. this is useful for recurring
data structures like part lists. put a [+] into the first varname, and use [] on the
following ones.

repeating these names in your template:

invoice.items[+].id
invoice.items[].parts_id

will result in:

$form->{invoice}->{items}->[
{
id => ...
parts_id => ...
},
{
id => ...
parts_id => ...
}
...
]

4. arrays

using brackets at the end of a name will result in a pure array to be created.
note that you mustn't use [+], which is reserved for array+hash access and will
result in undefined behaviour in array context.

filter.status[] => $form->{status}->[ val1, val2, ... ]

4edf06e5 Sven Schöling
=head2 C<update_business> PARAMS
66022cbd Sven Schöling
PARAMS (not named):
\%config, - config hashref
$business_id, - business id
$dbh - optional database handle

handles business (thats customer/vendor types) sequences.

special behaviour for empty strings in customerinitnumber field:
will in this case not increase the value, and return undef.

4edf06e5 Sven Schöling
=head2 C<redirect_header> $url
ad9563c8 Moritz Bunkus
Generates a HTTP redirection header for the new C<$url>. Constructs an
absolute URL including scheme, host name and port. If C<$url> is a
relative URL then it is considered relative to Lx-Office base URL.

This function C<die>s if headers have already been created with
C<$::form-E<gt>header>.

Examples:

print $::form->redirect_header('oe.pl?action=edit&id=1234');
print $::form->redirect_header('http://www.lx-office.org/');

4edf06e5 Sven Schöling
=head2 C<header>

Generates a general purpose http/html header and includes most of the scripts
ans stylesheets needed.

Only one header will be generated. If the method was already called in this
request it will not output anything and return undef. Also if no
HTTP_USER_AGENT is found, no header is generated.

Although header does not accept parameters itself, it will honor special
hashkeys of its Form instance:

=over 4

=item refresh_time

=item refresh_url

If one of these is set, a http-equiv refresh is generated. Missing parameters
default to 3 seconds and the refering url.

=item stylesheet

=item stylesheets

If these are arrayrefs the contents will be inlined into the header.

=item landscape

If true, a css snippet will be generated that sets the page in landscape mode.

=item favicon

Used to override the default favicon.

=item title

A html page title will be generated from this

66022cbd Sven Schöling
=back

=cut