X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=inline;f=SL%2FForm.pm;h=19f2b5cf59342f490a9085148d136b3720980153;hb=41b9f5c7c8067d67326c83e2d26df0898bc279ca;hp=9433173c6f5c0e01bca5021d2f5980b560cb6ca1;hpb=2879330bd173831981bdd8b25fc1900292efaeac;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index 9433173c6..19f2b5cf5 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -56,6 +56,8 @@ use SL::DBUtils;
use SL::DO;
use SL::IC;
use SL::IS;
+use SL::Layout::Dispatcher;
+use SL::Locale;
use SL::Mailer;
use SL::Menu;
use SL::MoreCommon qw(uri_encode uri_decode);
@@ -311,7 +313,7 @@ sub info {
',
- '',
- '',
- '',
- '',
- '',
- '',
- '',
- '',
- '';
+ push @header, map { qq|| } $layout->stylesheets;
+ push @header, " " if $self->{landscape};
+ push @header, "" if -f $self->{favicon};
+ push @header, map { qq|| } $layout->javascripts;
push @header, $self->{javascript} if $self->{javascript};
push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
- push @header, "" if $self->{fokus};
- push @header, sprintf "",
- join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title};
-
- # 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|
- |;
- }
my %doctypes = (
strict => qq||,
transitional => qq||,
frameset => qq||,
+ html5 => qq||,
);
# output
@@ -530,9 +513,7 @@ sub header {
EOT
print " $_\n" for @header;
print <
-
- $params{extra_code}
- $title_hack
+
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 "\n";
+ }
+
+ print <
+
+EOL
+}
+
sub ajax_response_header {
$main::lxdebug->enter_sub();
@@ -581,7 +581,7 @@ sub set_standard_title {
$::lxdebug->enter_sub;
my $self = shift;
- $self->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $self->{version}";
+ $self->{titlebar} = "kivitendo " . $::locale->text('Version') . " $self->{version}";
$self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name};
$self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
@@ -634,11 +634,9 @@ sub _prepare_html_template {
$additional_params->{"conf_latex_templates"} = $::lx_office_conf{print_templates}->{latex};
$additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument};
$additional_params->{"conf_vertreter"} = $::lx_office_conf{features}->{vertreter};
- $additional_params->{"conf_show_best_before"} = $::lx_office_conf{features}->{show_best_before};
$additional_params->{"conf_parts_image_css"} = $::lx_office_conf{features}->{parts_image_css};
$additional_params->{"conf_parts_listing_images"} = $::lx_office_conf{features}->{parts_listing_images};
$additional_params->{"conf_parts_show_image"} = $::lx_office_conf{features}->{parts_show_image};
- $additional_params->{"conf_payments_changeable"} = $::lx_office_conf{features}->{payments_changeable};
$additional_params->{"INSTANCE_CONF"} = $::instance_conf;
if (my $debug_options = $::lx_office_conf{debug}{options}) {
@@ -681,6 +679,8 @@ sub init_template {
return $self->template if $self->template;
+ # Force scripts/locales.pl to pick up the exception handling template.
+ # parse_html_template('generic/exception')
return $self->template(Template->new({
'INTERPOLATE' => 0,
'EVAL_PERL' => 0,
@@ -690,6 +690,7 @@ sub init_template {
'INCLUDE_PATH' => '.:templates/webpages',
'COMPILE_EXT' => '.tcc',
'COMPILE_DIR' => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
+ 'ERROR' => 'templates/webpages/generic/exception.html',
})) || die;
}
@@ -774,10 +775,8 @@ sub write_trigger {
# default
my %dateformats = (
"dd.mm.yy" => "%d.%m.%Y",
- "dd-mm-yy" => "%d-%m-%Y",
"dd/mm/yy" => "%d/%m/%Y",
"mm/dd/yy" => "%m/%d/%Y",
- "mm-dd-yy" => "%m-%d-%Y",
"yyyy-mm-dd" => "%Y-%m-%d",
);
@@ -851,37 +850,30 @@ sub format_amount {
$main::lxdebug->enter_sub(2);
my ($self, $myconfig, $amount, $places, $dash) = @_;
+ $amount ||= 0;
+ $dash ||= '';
+ my $neg = $amount < 0;
+ my $force_places = defined $places && $places >= 0;
- if ($amount eq "") {
- $amount = 0;
- }
-
- # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
+ $amount = $self->round_amount($amount, abs $places) if $force_places;
+ $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
- my $neg = ($amount =~ s/^-//);
- my $exp = ($amount =~ m/[e]/) ? 1 : 0;
+ # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
+ # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
+ # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
- if (defined($places) && ($places ne '')) {
- 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;
- }
- }
- $amount = $self->round_amount($amount, $places);
- }
+ $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
- my @p = split(/\./, $amount); # split amount at decimal point
-
- $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
+ my @p = split(/\./, $amount); # split amount at decimal point
+ $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
$amount = $p[0];
- $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne '');
+ if ($places || $p[1]) {
+ $amount .= $d[0]
+ . ( $p[1] || '' )
+ . (0 x (abs($places || 0) - length ($p[1]||''))); # pad the fraction
+ }
$amount = do {
($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
@@ -889,7 +881,6 @@ sub format_amount {
($neg ? "-$amount" : "$amount" ) ;
};
-
$main::lxdebug->leave_sub(2);
return $amount;
}
@@ -1094,30 +1085,33 @@ sub parse_template {
# OUT is used for the media, screen, printer, email
# for postscript we store a copy in a temporary file
- my $fileid = time;
- 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;
+ my ($temp_fh, $suffix);
+ $suffix = $self->{IN};
+ $suffix =~ s/.*\.//;
+ ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
+ 'kivitendo-printXXXXXX',
+ SUFFIX => '.' . ($suffix || 'tex'),
+ DIR => $userspath,
+ UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1,
+ );
+ close $temp_fh;
+ (undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
if ($template->uses_temp_file() || $self->{media} eq 'email') {
- $out = $self->{OUT};
- $out_mode = $self->{OUT_MODE} || '>';
- $self->{OUT} = "$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];
@@ -1152,24 +1146,20 @@ sub parse_template {
$mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
$mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
$mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
- $mail->{fileid} = "$fileid.";
+ $mail->{fileid} = time() . '.' . $$ . '.';
$myconfig->{signature} =~ s/\r//g;
# if we send html or plain text inline
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
- $mail->{contenttype} = "text/html";
-
- $mail->{message} =~ s/\r//g;
- $mail->{message} =~ s/\n/
\n/g;
- $myconfig->{signature} =~ s/\n/
\n/g;
- $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
";
+ $mail->{contenttype} = "text/html";
+ $mail->{message} =~ s/\r//g;
+ $mail->{message} =~ s/\n/
\n/g;
+ $myconfig->{signature} =~ s/\n/
\n/g;
+ $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
";
open(IN, "<", $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
- while () {
- $mail->{message} .= $_;
- }
-
+ $mail->{message} .= $_ while ;
close(IN);
} else {
@@ -1206,10 +1196,12 @@ sub parse_template {
#print(STDERR "OUT $self->{OUT}\n");
for my $i (1 .. $self->{copies}) {
if ($self->{OUT}) {
- open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$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 ;
close OUT;
- seek IN, 0, 0;
+ seek IN, 0, 0;
} else {
$self->{attachment_filename} = ($self->{attachment_filename})
@@ -1244,6 +1236,9 @@ sub get_formname_translation {
$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'),
@@ -1261,7 +1256,7 @@ sub get_formname_translation {
);
$main::lxdebug->leave_sub();
- return $formname_translations{$formname}
+ return $formname_translations{$formname};
}
sub get_number_prefix_for_type {
@@ -1297,11 +1292,14 @@ sub generate_attachment_filename {
$main::lxdebug->enter_sub();
my ($self) = @_;
+ $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
+ my $recipient_locale = Locale->new($self->{recipient_locale});
+
my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();
if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
- $attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format();
+ $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
} elsif ($attachment_filename && $self->{"${prefix}number"}) {
$attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
@@ -1609,7 +1607,7 @@ sub get_exchangerate {
my ($self, $dbh, $curr, $transdate, $fld) = @_;
my ($query);
- unless ($transdate) {
+ unless ($transdate && $curr) {
$main::lxdebug->leave_sub();
return 1;
}
@@ -1742,10 +1740,9 @@ sub set_payment_options {
$amounts{invtotal} = $self->{invtotal};
$amounts{total} = $self->{total};
}
- $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
-
map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
+ $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
$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});
@@ -1955,7 +1952,7 @@ sub get_employee_data {
my ($login) = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
if ($login) {
- my $user = User->new($login);
+ my $user = User->new(login => $login);
map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
$self->{$params{prefix} . '_login'} = $login;
@@ -1973,8 +1970,19 @@ sub get_duedate {
$reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date';
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});
+ my ($payment_id, $duedate);
+
+ if($self->{payment_id}) {
+ $payment_id = $self->{payment_id};
+ } elsif($self->{vendor_id}) {
+ my $query = 'SELECT payment_id FROM vendor WHERE id = ?';
+ ($payment_id) = selectrow_query($self, $dbh, $query, $self->{vendor_id});
+ }
+
+ if ($payment_id) {
+ my $query = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|;
+ ($duedate) = selectrow_query($self, $dbh, $query, $payment_id);
+ }
$main::lxdebug->leave_sub();
@@ -2512,7 +2520,7 @@ sub get_name {
return scalar(@{ $self->{name_list} });
}
-# the selection sub is used in the AR, AP, IS, IR and OE module
+# the selection sub is used in the AR, AP, IS, IR, DO and OE module
#
sub all_vc {
$main::lxdebug->enter_sub();
@@ -2524,13 +2532,17 @@ sub all_vc {
$table = $table eq "customer" ? "customer" : "vendor";
- my $query = qq|SELECT count(*) FROM $table|;
+ # build selection list
+ # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege
+ # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch
+ # nicht für veränderbare Belege (oe, do, ...)
+ my $obsolete = "WHERE NOT obsolete" unless $self->{id};
+ my $query = qq|SELECT count(*) FROM $table $obsolete|;
my ($count) = selectrow_query($self, $dbh, $query);
- # build selection list
- if ($count <= $myconfig->{vclimit}) {
+ if ($count < $myconfig->{vclimit}) {
$query = qq|SELECT id, name, salesman_id
- FROM $table WHERE NOT obsolete
+ FROM $table $obsolete
ORDER BY name|;
$self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
}
@@ -2541,7 +2553,8 @@ sub all_vc {
# setup sales contacts
$query = qq|SELECT e.id, e.name
FROM employee e
- WHERE (e.sales = '1') AND (NOT e.id = ?)|;
+ WHERE (e.sales = '1') AND (NOT e.id = ?)
+ ORDER BY name|;
$self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
# this is for self
@@ -2549,11 +2562,6 @@ sub all_vc {
{ id => $self->{employee_id},
name => $self->{employee} });
- # sort the whole thing
- @{ $self->{all_employees} } =
- sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
-
-
# prepare query for departments
$query = qq|SELECT id, description
FROM department
@@ -3568,6 +3576,29 @@ sub reformat_numbers {
$::myconfig{numberformat} = $saved_numberformat;
}
+sub layout {
+ my ($self) = @_;
+ $::lxdebug->enter_sub;
+
+ my %style_to_script_map = (
+ v3 => 'v3',
+ neu => 'new',
+ );
+
+ my $menu_script = $style_to_script_map{$::myconfig{menustyle}} || '';
+
+ package main;
+ require "bin/mozilla/menu$menu_script.pl";
+ package Form;
+ require SL::Controller::FrameHeader;
+
+
+ my $layout = SL::Controller::FrameHeader->new->action_header . ::render();
+
+ $::lxdebug->leave_sub;
+ return $layout;
+}
+
1;
__END__
@@ -3578,7 +3609,7 @@ SL::Form.pm - main data object.
=head1 SYNOPSIS
-This is the main data object of Lx-Office.
+This is the main data object of kivitendo.
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:
@@ -3603,7 +3634,7 @@ will in this case not increase the value, and return undef.
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.
+relative URL then it is considered relative to kivitendo base URL.
This function Cs if headers have already been created with
C<$::form-Eheader>.