X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=810891ef9a8510a3679083aacc7e36ebbfc17a9a;hb=c8e0c77f4da1fe14f1294a3be2e437c24f40eaea;hp=32675d8cee051282af9e4650d01c41229771f3f9;hpb=2c6997eca202daacb743c80d1d65c6faed61ad35;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 32675d8ce..810891ef9 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -56,11 +56,13 @@ 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); use SL::OE; +use SL::PrefixedNumber; use SL::Request; use SL::Template; use SL::User; @@ -379,9 +381,10 @@ 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 = $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http'; - my $port = $ENV{SERVER_PORT} || ''; + my $port = $ENV{SERVER_PORT}; $port = undef if (($scheme eq 'http' ) && ($port == 80)) || (($scheme eq 'https') && ($port == 443)); @@ -447,47 +450,37 @@ sub create_http_response { return $output; } -sub use_stylesheet { - my $self = shift; - - $self->{stylesheet} = [ $self->{stylesheet} ] unless ref $self->{stylesheet} eq 'ARRAY'; - $self->{stylesheet} = [ grep { -f } - map { m:^css/: ? $_ : "css/$_" } - grep { $_ } - (@{ $self->{stylesheet} }, @_) - ]; - - return @{ $self->{stylesheet} }; -} - -sub get_stylesheet_for_user { - my $css_path = 'css'; - if (my $user_style = $::myconfig{stylesheet}) { - $user_style =~ s/\.css$//; # nuke trailing .css, this is a remnand of pre 2.7.0 stylesheet handling - $css_path = "$css_path/$user_style" if -d "$css_path/$user_style"; - } else { - $css_path = "$css_path/lx-office-erp"; - } - $::myconfig{css_path} = $css_path; # needed for menunew, FIXME: don't do this here - - return $css_path; -} - sub header { $::lxdebug->enter_sub; - # extra code is currently only used by menuv3 and menuv4 to set their css. - # it is strongly deprecated, and will be changed in a future version. my ($self, %params) = @_; my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; my @header; $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++; - my $css_path = $self->get_stylesheet_for_user; + 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( + main menu list_accounts jquery.autocomplete + jquery.multiselect2side frame_header/header + ui-lightness/jquery-ui + jquery-ui.custom jqModal + ); + + $layout->use_javascript("$_.js") for (qw( + jquery jquery-ui jquery.cookie jqModal jquery.checkall jquery.download + common part_selection switchmenuframe + ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}"); $self->{favicon} ||= "favicon.ico"; - $self->{titlebar} = "$self->{title} - $self->{titlebar}" if $self->{title}; + $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title} || !$self->{titlebar}; # build includes if ($self->{refresh_url} || $self->{refresh_time}) { @@ -496,37 +489,20 @@ sub header { push @header, ""; } - push @header, map { qq|| } $self->use_stylesheet; + my $auto_reload_resources_param = $layout->auto_reload_resources_param; - push @header, "" if $self->{landscape}; - push @header, "" if -f $self->{favicon}; - push @header, map { qq|| } - qw(jquery common jscalendar/calendar jscalendar/lang/calendar-de jscalendar/calendar-setup part_selection jquery-ui jqModal switchmenuframe); - push @header, map { qq|| } - qw(main menu tabcontent list_accounts jquery.autocomplete jquery.multiselect2side frame_header/header ui-lightness/jquery-ui-1.8.12.custom); - push @header, map { qq|| } + 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 @@ -541,24 +517,34 @@ 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(); @@ -589,7 +575,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}; @@ -642,11 +628,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}) { @@ -689,6 +673,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, @@ -698,6 +684,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; } @@ -718,6 +705,14 @@ sub show_generic_error { return; } + if ($::request->is_ajax) { + $::lxdebug->message(0, "trying to render AJAX response..."); + SL::ClientJS->new + ->error($error) + ->render(SL::Controller::Base->new); + ::end_of_request(); + } + my $add_params = { 'title_error' => $params{title}, 'label_error' => $error, @@ -769,53 +764,6 @@ sub show_generic_information { ::end_of_request(); } -# write Trigger JavaScript-Code ($qty = quantity of Triggers) -# changed it to accept an arbitrary number of triggers - sschoeling -sub write_trigger { - $main::lxdebug->enter_sub(); - - my $self = shift; - my $myconfig = shift; - my $qty = shift; - - # set dateform for jsscript - # 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", - ); - - my $ifFormat = defined($dateformats{$myconfig->{"dateformat"}}) ? - $dateformats{$myconfig->{"dateformat"}} : "%d.%m.%Y"; - - my @triggers; - while ($#_ >= 2) { - push @triggers, qq| - Calendar.setup( - { - inputField : "| . (shift) . qq|", - ifFormat :"$ifFormat", - align : "| . (shift) . qq|", - button : "| . (shift) . qq|" - } - ); - |; - } - my $jsscript = qq| - - |; - - $main::lxdebug->leave_sub(); - - return $jsscript; -} #end sub write_trigger - sub _store_redirect_info_in_session { my ($self) = @_; @@ -859,39 +807,30 @@ sub format_amount { $main::lxdebug->enter_sub(2); my ($self, $myconfig, $amount, $places, $dash) = @_; - $dash ||= ''; - - if ($amount eq "") { - $amount = 0; - } - - # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13 + $amount ||= 0; + $dash ||= ''; + my $neg = $amount < 0; + my $force_places = defined $places && $places >= 0; - my $neg = ($amount =~ s/^-//); - my $exp = ($amount =~ m/[e]/) ? 1 : 0; + $amount = $self->round_amount($amount, abs $places) if $force_places; + $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa - if (defined($places) && ($places ne '')) { - if (not $exp) { - if ($places < 0) { - $amount *= 1; - $places *= -1; + # 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 ($amount =~ /\.(\d+)/) { - my $actual_places = length $1; - $places = $actual_places if $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" ) : @@ -899,7 +838,6 @@ sub format_amount { ($neg ? "-$amount" : "$amount" ) ; }; - $main::lxdebug->leave_sub(2); return $amount; } @@ -994,6 +932,11 @@ sub parse_amount { my ($self, $myconfig, $amount) = @_; + if (!defined($amount) || ($amount eq '')) { + $main::lxdebug->leave_sub(2); + return 0; + } + if ( ($myconfig->{numberformat} eq '1.000,00') || ($myconfig->{numberformat} eq '1000,00')) { $amount =~ s/\.//g; @@ -1055,7 +998,6 @@ sub parse_template { $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt'; } elsif ($self->{"format"} =~ /(postscript|pdf)/i) { - $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"}; $template_type = 'LaTeX'; $ext_for_format = 'pdf'; @@ -1108,12 +1050,13 @@ sub parse_template { $suffix = $self->{IN}; $suffix =~ s/.*\.//; ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile( - 'lx-office-printXXXXXX', + 'kivitendo-printXXXXXX', SUFFIX => '.' . ($suffix || 'tex'), DIR => $userspath, - UNLINK => 1, + 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}; @@ -1625,7 +1568,7 @@ sub get_exchangerate { my ($self, $dbh, $curr, $transdate, $fld) = @_; my ($query); - unless ($transdate) { + unless ($transdate && $curr) { $main::lxdebug->leave_sub(); return 1; } @@ -1758,10 +1701,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}); @@ -1989,8 +1931,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(); @@ -2540,13 +2493,17 @@ sub all_vc { $table = $table eq "customer" ? "customer" : "vendor"; - my $query = qq|SELECT count(*) FROM $table WHERE NOT obsolete|; + # 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 = $self->{id} ? '' : "WHERE NOT obsolete"; + 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); } @@ -2557,7 +2514,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 @@ -2565,11 +2523,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 @@ -2744,6 +2697,9 @@ sub create_links { $self->{TAX} = selectall_hashref_query($self, $dbh, $query); } + my $extra_columns = ''; + $extra_columns .= 'a.direct_debit, ' if ($module eq 'AR') || ($module eq 'AP'); + if ($self->{id}) { $query = qq|SELECT @@ -2751,7 +2707,7 @@ sub create_links { 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, - a.globalproject_id, + a.globalproject_id, ${extra_columns} c.name AS $table, d.description AS department, e.name AS employee @@ -3233,15 +3189,8 @@ sub update_defaults { my ($var) = $sth->fetchrow_array; $sth->finish; - 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'; - } - + $var = 0 if !defined($var) || ($var eq ''); + $var = SL::PrefixedNumber->new(number => $var)->get_next; $query = qq|UPDATE defaults SET $fld = ?|; do_query($self, $dbh, $query, $var); @@ -3458,7 +3407,7 @@ sub prepare_for_printing { IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount}); if ($self->{type} =~ /_delivery_order$/) { - DO->order_details(); + DO->order_details(\%::myconfig, $self); } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) { OE->order_details(\%::myconfig, $self); } else { @@ -3584,6 +3533,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__ @@ -3594,7 +3566,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: @@ -3619,7 +3591,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>.