projects
/
kivitendo-erp.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Steuerzone darf nicht leer sein
[kivitendo-erp.git]
/
SL
/
Form.pm
diff --git
a/SL/Form.pm
b/SL/Form.pm
index
468f6dc
..
f02c25a
100644
(file)
--- a/
SL/Form.pm
+++ b/
SL/Form.pm
@@
-42,6
+42,7
@@
use Data::Dumper;
use CGI;
use CGI::Ajax;
use Cwd;
use CGI;
use CGI::Ajax;
use Cwd;
+use Encode;
use IO::File;
use SL::Auth;
use SL::Auth::DB;
use IO::File;
use SL::Auth;
use SL::Auth::DB;
@@
-56,7
+57,7
@@
use SL::User;
use Template;
use URI;
use List::Util qw(first max min sum);
use Template;
use URI;
use List::Util qw(first max min sum);
-use List::MoreUtils qw(any);
+use List::MoreUtils qw(any
apply
);
use strict;
use strict;
@@
-257,21
+258,19
@@
sub new {
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
- if ($self->{INPUT_ENCODING}) {
- if (lc $self->{INPUT_ENCODING} ne lc $db_charset) {
- require Text::Iconv;
- my $iconv = Text::Iconv->new($self->{INPUT_ENCODING}, $db_charset);
+ my $encoding = $self->{INPUT_ENCODING} || $db_charset;
+ delete $self->{INPUT_ENCODING};
- _recode_recursively($iconv, $self);
- }
-
- delete $self->{INPUT_ENCODING};
- }
+ _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
$self->{action} = lc $self->{action};
$self->{action} =~ s/( |-|,|\#)/_/g;
$self->{action} = lc $self->{action};
$self->{action} =~ s/( |-|,|\#)/_/g;
- $self->{version} = "2.6.1";
+ #$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>;
+ close VERSION_FILE;
+ $self->{version} =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
$main::lxdebug->leave_sub();
$main::lxdebug->leave_sub();
@@
-381,6
+380,7
@@
sub escape {
my ($self, $str) = @_;
my ($self, $str) = @_;
+ $str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
$str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
$main::lxdebug->leave_sub(2);
$str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
$main::lxdebug->leave_sub(2);
@@
-472,13
+472,22
@@
sub info {
if (!$self->{header}) {
$self->header;
if (!$self->{header}) {
$self->header;
- print qq|
- <body>|;
+ print qq|<body>|;
}
print qq|
}
print qq|
+ <p class="message_ok"><b>$msg</b></p>
- <p><b>$msg</b>
+ <script type="text/javascript">
+ <!--
+ // 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);
+ //-->
+ </script>
+
+</body>
|;
} else {
|;
} else {
@@
-555,6
+564,20
@@
sub _get_request_uri {
return $uri;
}
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();
sub create_http_response {
$main::lxdebug->enter_sub();
@@
-651,6
+674,20
@@
sub header {
</script>
| if $self->{"fokus"};
</script>
| if $self->{"fokus"};
+ # 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>
+ |;
+ }
+
#Set Calendar
my $jsscript = "";
if ($self->{jsscript} == 1) {
#Set Calendar
my $jsscript = "";
if ($self->{jsscript} == 1) {
@@
-686,13
+723,12
@@
sub header {
$favicon
$jsscript
$ajax
$favicon
$jsscript
$ajax
-
$fokus
$fokus
+ $title_hack
<link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
<meta name="robots" content="noindex,nofollow" />
<link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
<meta name="robots" content="noindex,nofollow" />
- <script type="text/javascript" src="js/highlight_input.js"></script>
<link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
<script type="text/javascript" src="js/tabcontent.js">
<link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
<script type="text/javascript" src="js/tabcontent.js">
@@
-794,13
+830,13
@@
sub _prepare_html_template {
}
if (%main::myconfig) {
}
if (%main::myconfig) {
- map({ $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys(%main::myconfig));
- my $jsc_dateformat = $main::myconfig{"dateformat"};
- $jsc_dateformat =~ s/d+/\%d/gi;
- $jsc_dateformat =~ s/m+/\%m/gi;
- $jsc_dateformat =~ s/y+/\%Y/gi;
- $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat;
+ $::myconfig{jsc_dateformat} = apply {
+ s/d+/\%d/gi;
+ s/m+/\%m/gi;
+ s/y+/\%Y/gi;
+ } $::myconfig{"dateformat"};
$additional_params->{"myconfig"} ||= \%::myconfig;
$additional_params->{"myconfig"} ||= \%::myconfig;
+ map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
}
$additional_params->{"conf_dbcharset"} = $main::dbcharset;
}
$additional_params->{"conf_dbcharset"} = $main::dbcharset;
@@
-833,30
+869,42
@@
sub parse_html_template {
$additional_params ||= { };
$additional_params ||= { };
- $file = $self->_prepare_html_template($file, $additional_params);
-
- my $template = Template->new({ 'INTERPOLATE' => 0,
- 'EVAL_PERL' => 0,
- 'ABSOLUTE' => 1,
- 'CACHE_SIZE' => 0,
- 'PLUGIN_BASE' => 'SL::Template::Plugin',
- 'INCLUDE_PATH' => '.:templates/webpages',
- 'COMPILE_EXT' => $main::template_compile_ext,
- 'COMPILE_DIR' => $main::template_compile_dir,
- }) || die;
+ my $real_file = $self->_prepare_html_template($file, $additional_params);
+ my $template = $self->template || $self->init_template;
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
my $output;
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
my $output;
- if (!$template->process($file, $additional_params, \$output)) {
- print STDERR $template->error();
- }
+ $template->process($real_file, $additional_params, \$output) || die $template->error;
$main::lxdebug->leave_sub();
return $output;
}
$main::lxdebug->leave_sub();
return $output;
}
+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',
+ 'COMPILE_EXT' => '.tcc',
+ 'COMPILE_DIR' => $::userspath . '/templates-cache',
+ })) || die;
+}
+
+sub template {
+ my $self = shift;
+ $self->{template_object} = shift if @_;
+ return $self->{template_object};
+}
+
sub show_generic_error {
$main::lxdebug->enter_sub();
sub show_generic_error {
$main::lxdebug->enter_sub();
@@
-1172,7
+1220,7
@@
sub parse_template {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $userspath) = @_;
$main::lxdebug->enter_sub();
my ($self, $myconfig, $userspath) = @_;
- my
($template, $out)
;
+ my
$out
;
local (*IN, *OUT);
local (*IN, *OUT);
@@
-1181,31
+1229,29
@@
sub parse_template {
my $ext_for_format;
my $ext_for_format;
+ my $template_type;
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
- $template
= OpenDocumentTemplate->new($self->{"IN"}, $self, $myconfig, $userspath)
;
+ $template
_type = 'OpenDocument'
;
$ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
$ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"};
$ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
$ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"};
- $template
= LaTeXTemplate->new($self->{"IN"}, $self, $myconfig, $userspath)
;
+ $template
_type = 'LaTeX'
;
$ext_for_format = 'pdf';
} elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
$ext_for_format = 'pdf';
} elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
- $template
= HTMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath)
;
+ $template
_type = 'HTML'
;
$ext_for_format = 'html';
} elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
$ext_for_format = 'html';
} elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
- $template
= XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath)
;
+ $template
_type = 'XML'
;
$ext_for_format = 'xml';
$ext_for_format = 'xml';
- } elsif ( $self->{"format"} =~ /elsterwinston/i ) {
- $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath);
-
- } elsif ( $self->{"format"} =~ /elstertaxbird/i ) {
- $template = XMLTemplate->new($self->{"IN"}, $self, $myconfig, $userspath);
+ } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
+ $template_type = 'xml';
} elsif ( $self->{"format"} =~ /excel/i ) {
} elsif ( $self->{"format"} =~ /excel/i ) {
- $template
= ExcelTemplate->new($self->{"IN"}, $self, $myconfig, $userspath)
;
+ $template
_type = 'Excel'
;
$ext_for_format = 'xls';
} elsif ( defined $self->{'format'}) {
$ext_for_format = 'xls';
} elsif ( defined $self->{'format'}) {
@@
-1218,6
+1264,12
@@
sub parse_template {
$self->error("Outputformat not defined: $self->{'format'}");
}
$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);
+
# 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" };
# 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" };
@@
-1523,15
+1575,21
@@
sub datetonum {
# Database routines used throughout
# Database routines used throughout
+sub _dbconnect_options {
+ my $self = shift;
+ my $options = { pg_enable_utf8 => $::locale->is_utf8,
+ @_ };
+
+ return $options;
+}
+
sub dbconnect {
$main::lxdebug->enter_sub(2);
my ($self, $myconfig) = @_;
# connect to database
sub dbconnect {
$main::lxdebug->enter_sub(2);
my ($self, $myconfig) = @_;
# connect to database
- my $dbh =
- DBI->connect($myconfig->{dbconnect},
- $myconfig->{dbuser}, $myconfig->{dbpasswd})
+ my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
or $self->dberror;
# set db options
or $self->dberror;
# set db options
@@
-1550,9
+1608,7
@@
sub dbconnect_noauto {
my ($self, $myconfig) = @_;
# connect to database
my ($self, $myconfig) = @_;
# connect to database
- my $dbh =
- DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser},
- $myconfig->{dbpasswd}, { AutoCommit => 0 })
+ my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
or $self->dberror;
# set db options
or $self->dberror;
# set db options
@@
-1568,7
+1624,8
@@
sub dbconnect_noauto {
sub get_standard_dbh {
$main::lxdebug->enter_sub(2);
sub get_standard_dbh {
$main::lxdebug->enter_sub(2);
- my ($self, $myconfig) = @_;
+ my $self = shift;
+ my $myconfig = shift || \%::myconfig;
if ($standard_dbh && !$standard_dbh->{Active}) {
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
if ($standard_dbh && !$standard_dbh->{Active}) {
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
@@
-1769,8
+1826,9
@@
sub check_exchangerate {
sub get_all_currencies {
$main::lxdebug->enter_sub();
sub get_all_currencies {
$main::lxdebug->enter_sub();
- my ($self, $myconfig) = @_;
- my $dbh = $self->get_standard_dbh($myconfig);
+ my $self = shift;
+ my $myconfig = shift || \%::myconfig;
+ my $dbh = $self->get_standard_dbh($myconfig);
my $query = qq|SELECT curr FROM defaults|;
my $query = qq|SELECT curr FROM defaults|;
@@
-1962,7
+2020,7
@@
sub add_shipto {
my @values;
foreach my $item (qw(name department_1 department_2 street zipcode city country
my @values;
foreach my $item (qw(name department_1 department_2 street zipcode city country
- contact phone fax email)) {
+ contact
cp_gender
phone fax email)) {
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
@@
-1980,6
+2038,7
@@
sub add_shipto {
shiptocity = ?,
shiptocountry = ?,
shiptocontact = ?,
shiptocity = ?,
shiptocountry = ?,
shiptocontact = ?,
+ shiptocp_gender = ?,
shiptophone = ?,
shiptofax = ?,
shiptoemail = ?
shiptophone = ?,
shiptofax = ?,
shiptoemail = ?
@@
-1995,6
+2054,7
@@
sub add_shipto {
shiptocity = ? AND
shiptocountry = ? AND
shiptocontact = ? AND
shiptocity = ? AND
shiptocountry = ? AND
shiptocontact = ? AND
+ shiptocp_gender = ? AND
shiptophone = ? AND
shiptofax = ? AND
shiptoemail = ? AND
shiptophone = ? AND
shiptofax = ? AND
shiptoemail = ? AND
@@
-2005,8
+2065,8
@@
sub add_shipto {
$query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry,
$query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry,
- shiptocontact, shiptophone, shiptofax, shiptoemail, module)
- VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
+ shiptocontact, shipto
cp_gender, shipto
phone, shiptofax, shiptoemail, module)
+ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?
, ?
)|;
do_query($self, $dbh, $query, $id, @values, $module);
}
}
do_query($self, $dbh, $query, $id, @values, $module);
}
}
@@
-2345,9
+2405,13
@@
sub _get_customers {
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
my $limit_clause = "LIMIT $options->{limit}" if $options->{limit};
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
my $limit_clause = "LIMIT $options->{limit}" if $options->{limit};
- my $where = $options->{business_is_salesman} ? qq| AND business_id IN (SELECT id FROM business WHERE salesman)| : '';
- my $query = qq|SELECT * FROM customer WHERE NOT obsolete $where ORDER BY name $limit_clause|;
+ 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|;
$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
$main::lxdebug->leave_sub();
$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
$main::lxdebug->leave_sub();
@@
-2609,7
+2673,7
@@
sub all_vc {
my ($self, $myconfig, $table, $module) = @_;
my $ref;
my ($self, $myconfig, $table, $module) = @_;
my $ref;
- my $dbh = $self->get_standard_dbh
($myconfig)
;
+ my $dbh = $self->get_standard_dbh;
$table = $table eq "customer" ? "customer" : "vendor";
$table = $table eq "customer" ? "customer" : "vendor";
@@
-3017,8
+3081,8
@@
sub lastname_used {
sub current_date {
$main::lxdebug->enter_sub();
sub current_date {
$main::lxdebug->enter_sub();
- my $self
= shift;
- my $myconfig
= shift
|| \%::myconfig;
+ my $self = shift;
+ my $myconfig
= shift
|| \%::myconfig;
my ($thisdate, $days) = @_;
my $dbh = $self->get_standard_dbh($myconfig);
my ($thisdate, $days) = @_;
my $dbh = $self->get_standard_dbh($myconfig);
@@
-3221,8
+3285,8
@@
sub save_status {
sub save_history {
$main::lxdebug->enter_sub();
sub save_history {
$main::lxdebug->enter_sub();
- my $self = shift
()
;
- my $dbh
= shift()
;
+ my $self = shift;
+ my $dbh
= shift || $self->get_standard_dbh
;
if(!exists $self->{employee_id}) {
&get_employee($self, $dbh);
if(!exists $self->{employee_id}) {
&get_employee($self, $dbh);
@@
-3235,6
+3299,8
@@
sub save_history {
$self->{addition}, $self->{what_done}, "$self->{snumbers}");
do_query($self, $dbh, $query, @values);
$self->{addition}, $self->{what_done}, "$self->{snumbers}");
do_query($self, $dbh, $query, @values);
+ $dbh->commit;
+
$main::lxdebug->leave_sub();
}
$main::lxdebug->leave_sub();
}