|
#=====================================================================
|
|
# 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., 51 Franklin Street, Fifth Floor, Boston,
|
|
# MA 02110-1335, USA.
|
|
#======================================================================
|
|
# Utilities for parsing forms
|
|
# and supporting routines for linking account numbers
|
|
# used in AR, AP and IS, IR modules
|
|
#
|
|
#======================================================================
|
|
|
|
package Form;
|
|
|
|
use Carp;
|
|
use Data::Dumper;
|
|
|
|
use Carp;
|
|
use CGI;
|
|
use Cwd;
|
|
use Encode;
|
|
use File::Copy;
|
|
use File::Temp ();
|
|
use IO::File;
|
|
use Math::BigInt;
|
|
use Params::Validate qw(:all);
|
|
use POSIX qw(strftime);
|
|
use SL::Auth;
|
|
use SL::Auth::DB;
|
|
use SL::Auth::LDAP;
|
|
use SL::AM;
|
|
use SL::Common;
|
|
use SL::CVar;
|
|
use SL::DB;
|
|
use SL::DBConnect;
|
|
use SL::DBUtils;
|
|
use SL::DB::AdditionalBillingAddress;
|
|
use SL::DB::Customer;
|
|
use SL::DB::CustomVariableConfig;
|
|
use SL::DB::Default;
|
|
use SL::DB::PaymentTerm;
|
|
use SL::DB::Vendor;
|
|
use SL::DO;
|
|
use SL::Helper::Flash qw();
|
|
use SL::IC;
|
|
use SL::IS;
|
|
use SL::Layout::Dispatcher;
|
|
use SL::Locale;
|
|
use SL::Locale::String;
|
|
use SL::Mailer;
|
|
use SL::Menu;
|
|
use SL::MoreCommon qw(uri_encode uri_decode);
|
|
use SL::OE;
|
|
use SL::PrefixedNumber;
|
|
use SL::Request;
|
|
use SL::Template;
|
|
use SL::User;
|
|
use SL::Util;
|
|
use SL::Version;
|
|
use SL::X;
|
|
use Template;
|
|
use URI;
|
|
use List::Util qw(first max min sum);
|
|
use List::MoreUtils qw(all any apply);
|
|
use SL::DB::Tax;
|
|
use SL::Helper::File qw(:all);
|
|
use SL::Helper::Number;
|
|
use SL::Helper::CreatePDF qw(merge_pdfs);
|
|
|
|
use strict;
|
|
|
|
sub read_version {
|
|
SL::Version->get_version;
|
|
}
|
|
|
|
sub new {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my $type = shift;
|
|
|
|
my $self = {};
|
|
|
|
no warnings 'once';
|
|
if ($LXDebug::watch_form) {
|
|
require SL::Watchdog;
|
|
tie %{ $self }, 'SL::Watchdog';
|
|
}
|
|
|
|
bless $self, $type;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _flatten_variables_rec {
|
|
$main::lxdebug->enter_sub(2);
|
|
|
|
my $self = shift;
|
|
my $curr = shift;
|
|
my $prefix = shift;
|
|
my $key = shift;
|
|
|
|
my @result;
|
|
|
|
if ('' eq ref $curr->{$key}) {
|
|
@result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });
|
|
|
|
} elsif ('HASH' eq ref $curr->{$key}) {
|
|
foreach my $hash_key (sort keys %{ $curr->{$key} }) {
|
|
push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
|
|
}
|
|
|
|
} else {
|
|
foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
|
|
my $first_array_entry = 1;
|
|
|
|
my $element = $curr->{$key}[$idx];
|
|
|
|
if ('HASH' eq ref $element) {
|
|
foreach my $hash_key (sort keys %{ $element }) {
|
|
push @result, $self->_flatten_variables_rec($element, $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
|
|
$first_array_entry = 0;
|
|
}
|
|
} else {
|
|
push @result, { 'key' => $prefix . $key . '[]', 'value' => $element };
|
|
}
|
|
}
|
|
}
|
|
|
|
$main::lxdebug->leave_sub(2);
|
|
|
|
return @result;
|
|
}
|
|
|
|
sub flatten_variables {
|
|
$main::lxdebug->enter_sub(2);
|
|
|
|
my $self = shift;
|
|
my @keys = @_;
|
|
|
|
my @variables;
|
|
|
|
foreach (@keys) {
|
|
push @variables, $self->_flatten_variables_rec($self, '', $_);
|
|
}
|
|
|
|
$main::lxdebug->leave_sub(2);
|
|
|
|
return @variables;
|
|
}
|
|
|
|
sub flatten_standard_variables {
|
|
$main::lxdebug->enter_sub(2);
|
|
|
|
my $self = shift;
|
|
my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar), @_);
|
|
|
|
my @variables;
|
|
|
|
foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
|
|
push @variables, $self->_flatten_variables_rec($self, '', $_);
|
|
}
|
|
|
|
$main::lxdebug->leave_sub(2);
|
|
|
|
return @variables;
|
|
}
|
|
|
|
sub escape {
|
|
my ($self, $str) = @_;
|
|
|
|
return uri_encode($str);
|
|
}
|
|
|
|
sub unescape {
|
|
my ($self, $str) = @_;
|
|
|
|
return uri_decode($str);
|
|
}
|
|
|
|
sub quote {
|
|
$main::lxdebug->enter_sub();
|
|
my ($self, $str) = @_;
|
|
|
|
if ($str && !ref($str)) {
|
|
$str =~ s/\"/"/g;
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $str;
|
|
}
|
|
|
|
sub unquote {
|
|
$main::lxdebug->enter_sub();
|
|
my ($self, $str) = @_;
|
|
|
|
if ($str && !ref($str)) {
|
|
$str =~ s/"/\"/g;
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $str;
|
|
}
|
|
|
|
sub hide_form {
|
|
$main::lxdebug->enter_sub();
|
|
my $self = shift;
|
|
|
|
if (@_) {
|
|
map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
|
|
} else {
|
|
for (sort keys %$self) {
|
|
next if (($_ eq "header") || (ref($self->{$_}) ne ""));
|
|
print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
|
|
}
|
|
}
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub throw_on_error {
|
|
my ($self, $code) = @_;
|
|
local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) };
|
|
$code->();
|
|
}
|
|
|
|
sub error {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
$main::lxdebug->show_backtrace();
|
|
|
|
my ($self, $msg) = @_;
|
|
|
|
if ($self->{__ERROR_HANDLER}) {
|
|
$self->{__ERROR_HANDLER}->($msg);
|
|
|
|
} elsif ($ENV{HTTP_USER_AGENT}) {
|
|
$msg =~ s/\n/<br>/g;
|
|
$self->show_generic_error($msg);
|
|
|
|
} else {
|
|
confess "Error: $msg\n";
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub info {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $msg) = @_;
|
|
|
|
if ($ENV{HTTP_USER_AGENT}) {
|
|
$self->header;
|
|
print $self->parse_html_template('generic/form_info', { message => $msg });
|
|
|
|
} elsif ($self->{info_function}) {
|
|
&{ $self->{info_function} }($msg);
|
|
} else {
|
|
print "$msg\n";
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
# calculates the number of rows in a textarea based on the content and column number
|
|
# can be capped with maxrows
|
|
sub numtextrows {
|
|
$main::lxdebug->enter_sub();
|
|
my ($self, $str, $cols, $maxrows, $minrows) = @_;
|
|
|
|
$minrows ||= 1;
|
|
|
|
my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
|
|
$maxrows ||= $rows;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return max(min($rows, $maxrows), $minrows);
|
|
}
|
|
|
|
sub dberror {
|
|
my ($self, $msg) = @_;
|
|
|
|
SL::X::DBError->throw(
|
|
msg => $msg,
|
|
db_error => $DBI::errstr,
|
|
);
|
|
}
|
|
|
|
sub isblank {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $name, $msg) = @_;
|
|
|
|
my $curr = $self;
|
|
foreach my $part (split m/\./, $name) {
|
|
if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
|
|
$self->error($msg);
|
|
}
|
|
$curr = $curr->{$part};
|
|
}
|
|
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub _get_request_uri {
|
|
my $self = shift;
|
|
|
|
return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
|
|
return URI->new if !$ENV{REQUEST_URI}; # for testing
|
|
|
|
my $scheme = $::request->is_https ? '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;
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
sub create_http_response {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my $self = shift;
|
|
my %params = @_;
|
|
|
|
my $cgi = $::request->{cgi};
|
|
|
|
my $session_cookie;
|
|
if (defined $main::auth) {
|
|
my $uri = $self->_get_request_uri;
|
|
my @segments = $uri->path_segments;
|
|
pop @segments;
|
|
$uri->path_segments(@segments);
|
|
|
|
my $session_cookie_value = $main::auth->get_session_id();
|
|
|
|
if ($session_cookie_value) {
|
|
$session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
|
|
'-value' => $session_cookie_value,
|
|
'-path' => $uri->path,
|
|
'-expires' => '+' . $::auth->{session_timeout} . 'm',
|
|
'-secure' => $::request->is_https);
|
|
$session_cookie = "$session_cookie; SameSite=strict";
|
|
}
|
|
}
|
|
|
|
my %cgi_params = ('-type' => $params{content_type});
|
|
$cgi_params{'-charset'} = $params{charset} if ($params{charset});
|
|
$cgi_params{'-cookie'} = $session_cookie if ($session_cookie);
|
|
|
|
map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
|
|
|
|
my $output = $cgi->header(%cgi_params);
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $output;
|
|
}
|
|
|
|
sub header {
|
|
$::lxdebug->enter_sub;
|
|
|
|
my ($self, %params) = @_;
|
|
my @header;
|
|
|
|
$::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
|
|
|
|
if ($params{no_layout}) {
|
|
$::request->{layout} = SL::Layout::Dispatcher->new(style => 'none');
|
|
}
|
|
|
|
my $layout = $::request->{layout};
|
|
|
|
# standard css for all
|
|
# this should gradually move to the layouts that need it
|
|
$layout->use_stylesheet("$_.css") for qw(
|
|
common main menu list_accounts jquery.autocomplete
|
|
jquery.multiselect2side
|
|
ui-lightness/jquery-ui
|
|
jquery-ui.custom
|
|
tooltipster themes/tooltipster-light
|
|
);
|
|
|
|
$layout->use_javascript("$_.js") for (qw(
|
|
jquery jquery-ui jquery.cookie jquery.checkall jquery.download
|
|
jquery/jquery.form jquery/fixes namespace client_js
|
|
jquery/jquery.tooltipster.min
|
|
common part_selection
|
|
), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
|
|
|
|
$layout->use_javascript("$_.js") for @{ $params{use_javascripts} // [] };
|
|
|
|
$self->{favicon} ||= "favicon.ico";
|
|
$self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar};
|
|
|
|
# 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'>";
|
|
}
|
|
|
|
my $auto_reload_resources_param = $layout->auto_reload_resources_param;
|
|
|
|
push @header, map { qq|<link rel="stylesheet" href="${_}${auto_reload_resources_param}" type="text/css" title="Stylesheet">| } $layout->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, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| } $layout->javascripts;
|
|
push @header, '<meta name="viewport" content="width=device-width, initial-scale=1">';
|
|
push @header, $self->{javascript} if $self->{javascript};
|
|
push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
|
|
|
|
my %doctypes = (
|
|
strict => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
|
|
transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
|
|
frameset => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
|
|
html5 => qq|<!DOCTYPE html>|,
|
|
);
|
|
|
|
# output
|
|
print $self->create_http_response(content_type => 'text/html', charset => 'UTF-8');
|
|
print $doctypes{$params{doctype} || $::request->layout->html_dialect}, $/;
|
|
print <<EOT;
|
|
<html>
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
|
<title>$self->{titlebar}</title>
|
|
EOT
|
|
print " $_\n" for @header;
|
|
print <<EOT;
|
|
<meta name="robots" content="noindex,nofollow">
|
|
</head>
|
|
<body>
|
|
|
|
EOT
|
|
print $::request->{layout}->pre_content;
|
|
print $::request->{layout}->start_content;
|
|
|
|
$layout->header_done;
|
|
|
|
$::lxdebug->leave_sub;
|
|
}
|
|
|
|
sub footer {
|
|
return unless $::request->{layout}->need_footer;
|
|
|
|
print $::request->{layout}->end_content;
|
|
print $::request->{layout}->post_content;
|
|
|
|
if (my @inline_scripts = $::request->{layout}->javascripts_inline) {
|
|
print "<script type='text/javascript'>" . join("; ", @inline_scripts) . "</script>\n";
|
|
}
|
|
|
|
print <<EOL
|
|
</body>
|
|
</html>
|
|
EOL
|
|
}
|
|
|
|
sub ajax_response_header {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self) = @_;
|
|
|
|
my $output = $::request->{cgi}->header('-charset' => 'UTF-8');
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $output;
|
|
}
|
|
|
|
sub redirect_header {
|
|
my $self = shift;
|
|
my $new_url = shift;
|
|
|
|
my $base_uri = $self->_get_request_uri;
|
|
my $new_uri = URI->new_abs($new_url, $base_uri);
|
|
|
|
die "Headers already sent" if $self->{header};
|
|
$self->{header} = 1;
|
|
|
|
return $::request->{cgi}->redirect($new_uri);
|
|
}
|
|
|
|
sub set_standard_title {
|
|
$::lxdebug->enter_sub;
|
|
my $self = shift;
|
|
|
|
$self->{titlebar} = "kivitendo " . $::locale->text('Version') . " " . $self->read_version;
|
|
$self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name};
|
|
$self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
|
|
|
|
$::lxdebug->leave_sub;
|
|
}
|
|
|
|
sub _prepare_html_template {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $file, $additional_params) = @_;
|
|
my $language;
|
|
|
|
if (!%::myconfig || !$::myconfig{"countrycode"}) {
|
|
$language = $::lx_office_conf{system}->{language};
|
|
} else {
|
|
$language = $main::myconfig{"countrycode"};
|
|
}
|
|
$language = "de" unless ($language);
|
|
|
|
my $webpages_path = $::request->layout->webpages_path;
|
|
my $webpages_fallback = $::request->layout->webpages_fallback_path;
|
|
|
|
my @templates = first { -f } map { "${_}/${file}.html" } grep { defined } $webpages_path, $webpages_fallback;
|
|
|
|
if (@templates) {
|
|
$file = $templates[0];
|
|
} elsif (ref $file eq 'SCALAR') {
|
|
# file is a scalarref, use inline mode
|
|
} else {
|
|
my $info = "Web page template '${file}' not found.\n";
|
|
$::form->header;
|
|
print qq|<pre>$info</pre>|;
|
|
$::dispatcher->end_request;
|
|
}
|
|
|
|
$additional_params->{AUTH} = $::auth;
|
|
$additional_params->{INSTANCE_CONF} = $::instance_conf;
|
|
$additional_params->{LOCALE} = $::locale;
|
|
$additional_params->{LXCONFIG} = \%::lx_office_conf;
|
|
$additional_params->{LXDEBUG} = $::lxdebug;
|
|
$additional_params->{MYCONFIG} = \%::myconfig;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $file;
|
|
}
|
|
|
|
sub parse_html_template {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $file, $additional_params) = @_;
|
|
|
|
$additional_params ||= { };
|
|
|
|
my $real_file = $self->_prepare_html_template($file, $additional_params);
|
|
my $template = $self->template;
|
|
|
|
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
|
|
|
|
my $output;
|
|
$template->process($real_file, $additional_params, \$output) || die $template->error;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return $output;
|
|
}
|
|
|
|
sub template { $::request->presenter->get_template }
|
|
|
|
sub show_generic_error {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $error, %params) = @_;
|
|
|
|
if ($self->{__ERROR_HANDLER}) {
|
|
$self->{__ERROR_HANDLER}->($error);
|
|
$main::lxdebug->leave_sub();
|
|
return;
|
|
}
|
|
|
|
if ($::request->is_ajax) {
|
|
SL::ClientJS->new
|
|
->error($error)
|
|
->render(SL::Controller::Base->new);
|
|
$::dispatcher->end_request;
|
|
}
|
|
|
|
my $add_params = {
|
|
'title_error' => $params{title},
|
|
'label_error' => $error,
|
|
};
|
|
|
|
$self->{title} = $params{title} if $params{title};
|
|
|
|
for my $bar ($::request->layout->get('actionbar')) {
|
|
$bar->add(
|
|
action => [
|
|
t8('Back'),
|
|
call => [ 'kivi.history_back' ],
|
|
accesskey => 'enter',
|
|
],
|
|
);
|
|
}
|
|
|
|
$self->header();
|
|
print $self->parse_html_template("generic/error", $add_params);
|
|
|
|
print STDERR "Error: $error\n";
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
$::dispatcher->end_request;
|
|
}
|
|
|
|
sub show_generic_information {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $text, $title) = @_;
|
|
|
|
my $add_params = {
|
|
'title_information' => $title,
|
|
'label_information' => $text,
|
|
};
|
|
|
|
$self->{title} = $title if ($title);
|
|
|
|
$self->header();
|
|
print $self->parse_html_template("generic/information", $add_params);
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
$::dispatcher->end_request;
|
|
}
|
|
|
|
sub _store_redirect_info_in_session {
|
|
my ($self) = @_;
|
|
|
|
return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x;
|
|
|
|
my ($controller, $params) = ($1, $2);
|
|
my $form = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params };
|
|
$self->{callback} = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form);
|
|
}
|
|
|
|
sub redirect {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $msg) = @_;
|
|
|
|
if (!$self->{callback}) {
|
|
$self->info($msg);
|
|
|
|
} else {
|
|
SL::Helper::Flash::flash_later('info', $msg) if $msg;
|
|
$self->_store_redirect_info_in_session;
|
|
print $::form->redirect_header($self->{callback});
|
|
}
|
|
|
|
$::dispatcher->end_request;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
# sort of columns removed - empty sub
|
|
sub sort_columns {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, @columns) = @_;
|
|
|
|
$main::lxdebug->leave_sub();
|
|
|
|
return @columns;
|
|
}
|
|
#
|
|
|
|
sub format_amount {
|
|
my ($self, $myconfig, $amount, $places, $dash) = @_;
|
|
SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
|
|
}
|
|
|
|
sub format_string {
|
|
$main::lxdebug->enter_sub(2);
|
|
|
|
my $self = shift;
|
|
my $input = shift;
|
|
|
|
$input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx;
|
|
$input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
|
|
$input =~ s/\#\#/\#/g;
|
|
|
|
$main::lxdebug->leave_sub(2);
|
|
|
|
return $input;
|
|
}
|
|
|
|
#
|
|
|
|
sub parse_amount {
|
|
my ($self, $myconfig, $amount) = @_;
|
|
SL::Helper::Number::_parse_number($amount, %$myconfig);
|
|
}
|
|
|
|
sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
|
|
|
|
sub parse_template {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self, $myconfig) = @_;
|
|
my ($out, $out_mode);
|
|
|
|
local (*IN, *OUT);
|
|
|
|
my $defaults = SL::DB::Default->get;
|
|
|
|
my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files};
|
|
$self->{cwd} = getcwd();
|
|
my $temp_dir = File::Temp->newdir(
|
|
"kivitendo-print-XXXXXX",
|
|
DIR => $self->{cwd} . "/" . $::lx_office_conf{paths}->{userspath},
|
|
CLEANUP => !$keep_temp_files,
|
|
);
|
|
|
|
my $userspath = File::Spec->abs2rel($temp_dir->dirname);
|
|
$self->{tmpdir} = $temp_dir->dirname;
|
|
|
|
my $ext_for_format;
|
|
|
|
my $template_type;
|
|
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
|
|
$template_type = 'OpenDocument';
|
|
$ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
|
|
|
|
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
|
|
$template_type = 'LaTeX';
|
|
$ext_for_format = 'pdf';
|
|
|
|
} elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
|
|
$template_type = 'HTML';
|
|
$ext_for_format = 'html';
|
|
|
|
} elsif ( $self->{"format"} =~ /excel/i ) {
|
|
$template_type = 'Excel';
|
|
$ext_for_format = 'xls';
|
|
|
|
} elsif ( defined $self->{'format'}) {
|
|
$self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
|
|
|
|
} elsif ( $self->{'format'} eq '' ) {
|
|
$self->error("No Outputformat given: $self->{'format'}");
|
|
|
|
} else { #Catch the rest
|
|
$self->error("Outputformat not defined: $self->{'format'}");
|
|
}
|
|
|
|
my $template = SL::Template::create(type => $template_type,
|
|
file_name => $self->{IN},
|
|
form => $self,
|
|
myconfig => $myconfig,
|
|
userspath => $userspath,
|
|
%{ $self->{TEMPLATE_DRIVER_OPTIONS} || {} });
|
|
|
|
# Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
|
|
$self->{"notes"} = $self->{ $self->{"formname"} . "notes" } if exists $self->{ $self->{"formname"} . "notes" };
|
|
|
|
if (!$self->{employee_id}) {
|
|
$self->{"employee_${_}"} = $myconfig->{$_} for qw(email tel fax name signature);
|
|
$self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
|
|
}
|
|
|
|
$self->{"myconfig_${_}"} = $myconfig->{$_} for grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
|
|
$self->{$_} = $defaults->$_ for qw(co_ustid);
|
|
$self->{"myconfig_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
|
|
$self->{AUTH} = $::auth;
|
|
$self->{INSTANCE_CONF} = $::instance_conf;
|
|
$self->{LOCALE} = $::locale;
|
|
$self->{LXCONFIG} = $::lx_office_conf;
|
|
$self->{LXDEBUG} = $::lxdebug;
|
|
$self->{MYCONFIG} = \%::myconfig;
|
|
|
|
$self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
|
|
|
|
# OUT is used for the media, screen, printer, email
|
|
# for postscript we store a copy in a temporary file
|
|
|
|
my ($temp_fh, $suffix);
|
|
$suffix = $self->{IN};
|
|
$suffix =~ s/.*\.//;
|
|
($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
|
|
strftime('kivitendo-print-%Y%m%d%H%M%S-XXXXXX', localtime()),
|
|
SUFFIX => '.' . ($suffix || 'tex'),
|
|
DIR => $userspath,
|
|
UNLINK => $keep_temp_files ? 0 : 1,
|
|
);
|
|
close $temp_fh;
|
|
chmod 0644, $self->{tmpfile} if $keep_temp_files;
|
|
(undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
|
|
|
|
$out = $self->{OUT};
|
|
$out_mode = $self->{OUT_MODE} || '>';
|
|
$self->{OUT} = "$self->{tmpfile}";
|
|
$self->{OUT_MODE} = '>';
|
|
|
|
my $result;
|
|
my $command_formatter = sub {
|
|
my ($out_mode, $out) = @_;
|
|
return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
|
|
};
|
|
|
|
if ($self->{OUT}) {
|
|
$self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
|
|
open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
|
|
} else {
|
|
*OUT = ($::dispatcher->get_standard_filehandles)[1];
|
|
$self->header;
|
|
}
|
|
|
|
if (!$template->parse(*OUT)) {
|
|
$self->cleanup();
|
|
$self->error("$self->{IN} : " . $template->get_error());
|
|
}
|
|
|
|
close OUT if $self->{OUT};
|
|
# check only one flag (webdav_documents)
|
|
# therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
|
|
my $copy_to_webdav = $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}
|
|
&& $self->{type} ne 'statement';
|
|
|
|
$self->{attachment_filename} ||= $self->generate_attachment_filename;
|
|
|
|
if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) {
|
|
$self->append_general_pdf_attachments(filepath => $self->{tmpdir}."/".$self->{tmpfile},
|
|
type => $self->{type});
|
|
}
|
|
if ($self->{media} eq 'file') {
|
|
copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
|
|
|
|
if ($copy_to_webdav) {
|
|
if (my $error = Common::copy_file_to_webdav_folder($self)) {
|
|
chdir("$self->{cwd}");
|
|
$self->error($error);
|
|
}
|
|
}
|
|
|
|
if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled)
|
|
{
|
|
$self->store_pdf($self);
|
|
}
|
|
$self->cleanup;
|
|
chdir("$self->{cwd}");
|
|
|
|
$::lxdebug->leave_sub();
|
|
|
|
return;
|
|
}
|
|
|
|
if ($copy_to_webdav) {
|
|
if (my $error = Common::copy_file_to_webdav_folder($self)) {
|
|
chdir("$self->{cwd}");
|
|
$self->error($error);
|
|
}
|
|
}
|
|
|
|
if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
|
|
my $file_obj = $self->store_pdf($self);
|
|
$self->{print_file_id} = $file_obj->id if $file_obj;
|
|
}
|
|
# dn has its own send email method, but sets media for print templates
|
|
if ($self->{media} eq 'email' && !$self->{dunning_id}) {
|
|
if ( getcwd() eq $self->{"tmpdir"} ) {
|
|
# in the case of generating pdf we are in the tmpdir, but WHY ???
|
|
$self->{tmpfile} = $userspath."/".$self->{tmpfile};
|
|
chdir("$self->{cwd}");
|
|
}
|
|
$self->send_email(\%::myconfig,$ext_for_format);
|
|
}
|
|
else {
|
|
$self->{OUT} = $out;
|
|
$self->{OUT_MODE} = $out_mode;
|
|
$self->output_file($template->get_mime_type,$command_formatter);
|
|
}
|
|
delete $self->{print_file_id};
|
|
|
|
$self->cleanup;
|
|
|
|
chdir("$self->{cwd}");
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub get_bcc_defaults {
|
|
my ($self, $myconfig, $mybcc) = @_;
|
|
if (SL::DB::Default->get->bcc_to_login) {
|
|
$mybcc .= ", " if $mybcc;
|
|
$mybcc .= $myconfig->{email};
|
|
}
|
|
my $otherbcc = SL::DB::Default->get->global_bcc;
|
|
if ($otherbcc) {
|
|
$mybcc .= ", " if $mybcc;
|
|
$mybcc .= $otherbcc;
|
|
}
|
|
return $mybcc;
|
|
}
|
|
|
|
sub send_email {
|
|
$main::lxdebug->enter_sub();
|
|
my ($self, $myconfig, $ext_for_format) = @_;
|
|
my $mail = Mailer->new;
|
|
|
|
map { $mail->{$_} = $self->{$_} }
|
|
qw(cc subject message format);
|
|
|
|
if ($self->{cc_employee}) {
|
|
my ($user, $my_emp_cc);
|
|
$user = SL::DB::Manager::AuthUser->find_by(login => $self->{cc_employee});
|
|
$my_emp_cc = $user->get_config_value('email') if ref $user eq 'SL::DB::AuthUser';
|
|
$mail->{cc} .= ", " if $mail->{cc};
|
|
$mail->{cc} .= $my_emp_cc if $my_emp_cc;
|
|
}
|
|
|
|
$mail->{bcc} = $self->get_bcc_defaults($myconfig, $self->{bcc});
|
|
$mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
|
|
$mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
|
|
$mail->{fileid} = time() . '.' . $$ . '.';
|
|
$mail->{content_type} = "text/html";
|
|
my $full_signature = $self->create_email_signature();
|
|
|
|
$mail->{attachments} = [];
|
|
my @attfiles;
|
|
# if we send html or plain text inline
|
|
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
|
|
$mail->{message} =~ s/\r//g;
|
|
$mail->{message} =~ s{\n}{<br>\n}g;
|
|
$mail->{message} .= $full_signature;
|
|
|
|
open(IN, "<", $self->{tmpfile})
|
|
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
|
|
$mail->{message} .= $_ while <IN>;
|
|
close(IN);
|
|
|
|
} elsif (($self->{attachment_policy} // '') ne 'no_file') {
|
|
my $attachment_name = $self->{attachment_filename} || $self->{tmpfile};
|
|
$attachment_name =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
|
|
|
|
if (($self->{attachment_policy} // '') eq 'old_file') {
|
|
my ( $attfile ) = SL::File->get_all(object_id => $self->{id},
|
|
object_type => $self->{type},
|
|
file_type => 'document',
|
|
print_variant => $self->{formname},);
|
|
|
|
if ($attfile) {
|
|
$attfile->{override_file_name} = $attachment_name if $attachment_name;
|
|
push @attfiles, $attfile;
|
|
$self->{file_id} = $attfile->id;
|
|
}
|
|
|
|
} else {
|
|
push @{ $mail->{attachments} }, { path => $self->{tmpfile},
|
|
id => $self->{print_file_id},
|
|
type => "application/pdf",
|
|
name => $attachment_name };
|
|
}
|
|
}
|
|
|
|
push @attfiles,
|
|
grep { $_ }
|
|
map { SL::File->get(id => $_) }
|
|
@{ $self->{attach_file_ids} // [] };
|
|
|
|
foreach my $attfile ( @attfiles ) {
|
|
push @{ $mail->{attachments} }, {
|
|
path => $attfile->get_file,
|
|
id => $attfile->id,
|
|
type => $attfile->mime_type,
|
|
name => $attfile->{override_file_name} // $attfile->file_name,
|
|
content => $attfile->get_content ? ${ $attfile->get_content } : undef,
|
|
};
|
|
}
|
|
|
|
$mail->{message} =~ s/\r//g;
|
|
$mail->{message} .= $full_signature;
|
|
$self->{emailerr} = $mail->send();
|
|
|
|
$self->{email_journal_id} = $mail->{journalentry};
|
|
$self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id};
|
|
$self->{what_done} = $::form->{type};
|
|
$self->{addition} = "MAILED";
|
|
$self->save_history;
|
|
|
|
if ($self->{emailerr}) {
|
|
$self->cleanup;
|
|
$self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
|
|
}
|
|
|
|
#write back for message info and mail journal
|
|
$self->{cc} = $mail->{cc};
|
|
$self->{bcc} = $mail->{bcc};
|
|
$self->{email} = $mail->{to};
|
|
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub output_file {
|
|
$main::lxdebug->enter_sub();
|
|
|
|
my ($self,$mimeType,$command_formatter) = @_;
|
|
my $numbytes = (-s $self->{tmpfile});
|
|
open(IN, "<", $self->{tmpfile})
|
|
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
|
|
binmode IN;
|
|
|
|
$self->{copies} = 1 unless $self->{media} eq 'printer';
|
|
|
|
chdir("$self->{cwd}");
|
|
for my $i (1 .. $self->{copies}) {
|
|
if ($self->{OUT}) {
|
|
$self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
|
|
|
|
open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
|
|
print OUT $_ while <IN>;
|
|
close OUT;
|
|
seek IN, 0, 0;
|
|
|
|
} else {
|
|
my %headers = ('-type' => $mimeType,
|
|
'-connection' => 'close',
|
|
'-charset' => 'UTF-8');
|
|
|
|
$self->{attachment_filename} ||= $self->generate_attachment_filename;
|
|
|
|
if ($self->{attachment_filename}) {
|
|
%headers = (
|
|
%headers,
|
|
'-attachment' => $self->{attachment_filename},
|
|
'-content-length' => $numbytes,
|
|
'-charset' => '',
|
|
);
|
|
}
|
|
|
|
print $::request->cgi->header(%headers);
|
|
|
|
$::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
|
|
}
|
|
}
|
|
close(IN);
|
|
$main::lxdebug->leave_sub();
|
|
}
|
|
|
|
sub get_formname_translation {
|
|
$main::lxdebug->enter_sub();
|
|
my ($self, $formname) = @_;
|
|
|
|
$formname ||= $self->{formname};
|
|
|
|
$self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
|
|
local $::locale = Locale->new($self->{recipient_locale});
|
|
|
|
my %formname_translations = (
|
|
bin_list => $main::locale->text('Bin List'),
|
|
credit_note => $main::locale->text('Credit Note'),
|
|
invoice => $main::locale->text('Invoice'),
|
|
invoice_copy => $main::locale->text('Invoice Copy'),
|
|
invoice_for_advance_payment => $main::locale->text('Invoice for Advance Payment'),
|
|
final_invoice => $main::locale->text('Final Invoice'),
|
|
pick_list => $main::locale->text('Pick List'),
|
|
proforma => $main::locale->text('Proforma Invoice'),
|
|
purchase_order => $main::locale->text('Purchase Order'),
|
|
purchase_order_confirmation => $main::locale->text('Purchase Order Confirmation'),
|
|
request_quotation => $main::locale->text('RFQ'),
|
|
purchase_quotation_intake => $main::locale->text('Purchase Quotation Intake'),
|
|
sales_order_intake => $main::locale->text('Sales Order Intake'),
|
|
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'),
|
|
supplier_delivery_order => $main::locale->text('Supplier Delivery Order'),
|
|
rma_delivery_order => $main::locale->text('RMA Delivery Order'),
|
|
sales_reclamation => $main::locale->text('Sales Reclamation'),
|
|
purchase_reclamation => $main::locale->text('Purchase Reclamation'),
|