X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=4c630f119503a8649b79285d8c1ced6fe2a2a065;hb=33c1a7f111af21221572871e95a1b77e3e16aa51;hp=a926b3cdd9c63433bc768afb1eeba4322e8210fb;hpb=d5ccfcf21289d20cbde0054853e65a497cdce77d;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index a926b3cdd..4c630f119 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -38,17 +38,21 @@ package Form; use Data::Dumper; -use Cwd; -use HTML::Template; -use Template; -use SL::Template; +use CGI; use CGI::Ajax; +use Cwd; +use List::Util qw(min max); +use SL::Auth; +use SL::Auth::DB; +use SL::Auth::LDAP; +use SL::AM; +use SL::Common; use SL::DBUtils; use SL::Mailer; use SL::Menu; +use SL::Template; use SL::User; -use SL::Common; -use CGI; +use Template; use List::Util qw(max min sum); my $standard_dbh; @@ -60,36 +64,71 @@ sub DESTROY { } } +sub _store_value { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $key = shift; + my $value = shift; + + my $curr = $self; + + while ($key =~ /\[\+?\]\.|\./) { + substr($key, 0, $+[0]) = ''; + + if ($& eq '.') { + $curr->{$`} ||= { }; + $curr = $curr->{$`}; + + } else { + $curr->{$`} ||= [ ]; + if (!scalar @{ $curr->{$`} } || $& eq '[+].') { + push @{ $curr->{$`} }, { }; + } + + $curr = $curr->{$`}->[-1]; + } + } + + $curr->{$key} = $value; + + $main::lxdebug->leave_sub(2); + + return \$curr->{$key}; +} + sub _input_to_hash { $main::lxdebug->enter_sub(2); - my $input = $_[0]; - my %in = (); + my $self = shift; + my $input = shift; + my @pairs = split(/&/, $input); foreach (@pairs) { - my ($name, $value) = split(/=/, $_, 2); - $in{$name} = unescape(undef, $value); + my ($key, $value) = split(/=/, $_, 2); + $self->_store_value($self->unescape($key), $self->unescape($value)); } $main::lxdebug->leave_sub(2); - - return %in; } sub _request_to_hash { $main::lxdebug->enter_sub(2); - my ($input) = @_; + my $self = shift; + my $input = shift; if (!$ENV{'CONTENT_TYPE'} || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) { + + $self->_input_to_hash($input); + $main::lxdebug->leave_sub(2); - return _input_to_hash($input); + return; } - my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr); - my %params; + my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous); my $boundary = '--' . $1; @@ -97,9 +136,9 @@ sub _request_to_hash { last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r")); if (($line eq $boundary) || ($line eq "$boundary\r")) { - $params{$name} =~ s|\r?\n$|| if $name; + ${ $previous } =~ s|\r?\n$|| if $previous; - undef $name; + undef $previous; undef $filename; $headers_done = 0; @@ -131,8 +170,8 @@ sub _request_to_hash { substr $line, $-[0], $+[0] - $-[0], ""; } - $params{$name} = ""; - $params{FILENAME} = $filename if ($filename); + $previous = $self->_store_value($name, ''); + $self->{FILENAME} = $filename if ($filename); next; } @@ -144,15 +183,14 @@ sub _request_to_hash { next; } - next unless $name; + next unless $previous; - $params{$name} .= "${line}\n"; + ${ $previous } .= "${line}\n"; } - $params{$name} =~ s|\r?\n$|| if $name; + ${ $previous } =~ s|\r?\n$|| if $previous; $main::lxdebug->leave_sub(2); - return %params; } sub new { @@ -177,17 +215,86 @@ sub new { $_ = $ARGV[0]; } - my %parameters = _request_to_hash($_); - map({ $self->{$_} = $parameters{$_}; } keys(%parameters)); + bless $self, $type; + + $self->_request_to_hash($_); - $self->{action} = lc $self->{action}; - $self->{action} =~ s/( |-|,|\#)/_/g; + $self->{action} = lc $self->{action}; + $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.4.3"; + $self->{version} = "2.4.3"; $main::lxdebug->leave_sub(); - bless $self, $type; + 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; + + 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; +} + +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; } sub debug { @@ -202,6 +309,24 @@ sub debug { $main::lxdebug->leave_sub(); } +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; +} + sub escape { $main::lxdebug->enter_sub(2); @@ -257,10 +382,11 @@ sub quote_html { my ($self, $str) = @_; my %replace = - ('order' => ['"', '<', '>'], - '<' => '<', - '>' => '>', - '"' => '"', + ('order' => ['&', '"', '<', '>'], + '<' => '<', + '>' => '>', + '"' => '"', + '&' => '&', ); map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); @@ -270,6 +396,33 @@ sub quote_html { return $str; } +sub unquote_html { + $main::lxdebug->enter_sub(2); + + my ($self, $str) = @_; + + my %replace = + ('ä' => 'ä', + 'ö' => 'ö', + 'ü' => 'ü', + 'Ä' => 'Ä', + 'Ö' => 'Ö', + 'Ü' => 'Ü', + 'ß' => 'ß', + '>' => '>', + '<' => '<', + '"' => '"', + ); + + map { $str =~ s/\Q$_\E/$replace{$_}/g; } keys %replace; + $str =~ s/\&/\&/g; + + $main::lxdebug->leave_sub(2); + + return $str; +} + + sub hide_form { my $self = shift; @@ -337,13 +490,16 @@ sub info { # can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); - my ($self, $str, $cols, $maxrows) = @_; + 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 min $rows, $maxrows; + + return max(min($rows, $maxrows), $minrows); } sub dberror { @@ -361,9 +517,14 @@ sub isblank { my ($self, $name, $msg) = @_; - if ($self->{$name} =~ /^\s*$/) { - $self->error($msg); + my $curr = $self; + foreach my $part (split '.', $name) { + if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) { + $self->error($msg); + } + $curr = $curr->{$part}; } + $main::lxdebug->leave_sub(); } @@ -377,6 +538,9 @@ sub header { return; } + my $cgi = $main::cgi; + $cgi ||= CGI->new(''); + my ($stylesheet, $favicon); if ($ENV{HTTP_USER_AGENT}) { @@ -437,9 +601,32 @@ sub header { foreach $item (@ { $self->{AJAX} }) { $ajax .= $item->show_javascript(); } - print qq|Content-Type: text/html; charset=${db_charset}; -${doctype} + my $base_path; + + if ($ENV{HTTP_X_FORWARDED_FOR}) { + $base_path = $ENV{HTTP_REFERER}; + $base_path =~ s|^.*?://.*?/|/|; + } else { + $base_path = $ENV{REQUEST_URI}; + } + $base_path =~ s|[^/]+$||; + $base_path =~ s|/$||; + + my $session_cookie; + if (defined $main::auth) { + my $session_cookie_value = $main::auth->get_session_id(); + $session_cookie_value ||= 'NO_SESSION'; + + $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(), + '-value' => $session_cookie_value, + '-path' => $base_path); + } + + print $cgi->header('-type' => 'text/html', + '-charset' => $db_charset, + '-cookie' => $session_cookie); + print qq|${doctype} $self->{titlebar} $stylesheet @@ -542,43 +729,18 @@ sub _prepare_html_template { map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options; } - $main::lxdebug->leave_sub(); - - return $file; -} - -sub parse_html_template { - $main::lxdebug->enter_sub(); - - my ($self, $file, $additional_params) = @_; - - $additional_params ||= { }; - - $file = $self->_prepare_html_template($file, $additional_params); - - my $template = HTML::Template->new("filename" => $file, - "die_on_bad_params" => 0, - "strict" => 0, - "case_sensitive" => 1, - "loop_context_vars" => 1, - "global_vars" => 1); - - foreach my $key ($template->param()) { - my $param = $additional_params->{$key} || $self->{$key}; - $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY")); - $template->param($key => $param); + 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; + } } - my $output = $template->output(); - - $output = $main::locale->{iconv}->convert($output) if ($main::locale); - $main::lxdebug->leave_sub(); - return $output; + return $file; } -sub parse_html_template2 { +sub parse_html_template { $main::lxdebug->enter_sub(); my ($self, $file, $additional_params) = @_; @@ -587,11 +749,12 @@ sub parse_html_template2 { $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', + my $template = Template->new({ 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', }) || die; map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; @@ -611,9 +774,10 @@ sub parse_html_template2 { sub show_generic_error { my ($self, $error, $title, $action) = @_; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_error"} = $error; + my $add_params = { + 'title_error' => $title, + 'label_error' => $error, + }; my @vars; if ($action) { @@ -626,21 +790,26 @@ sub show_generic_error { } $add_params->{"VARIABLES"} = \@vars; + $self->{title} = $title if ($title); + $self->header(); - print($self->parse_html_template("generic/error", $add_params)); + print $self->parse_html_template("generic/error", $add_params); die("Error: $error\n"); } sub show_generic_information { - my ($self, $error, $title) = @_; + my ($self, $text, $title) = @_; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_information"} = $error; + 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)); + print $self->parse_html_template("generic/information", $add_params); die("Information: $error\n"); } @@ -770,7 +939,71 @@ sub format_amount { $main::lxdebug->leave_sub(2); return $amount; } -# + +sub format_amount_units { + $main::lxdebug->enter_sub(); + + my $self = shift; + my %params = @_; + + Common::check_params(\%params, qw(amount part_unit)); + + my $myconfig = \%main::myconfig; + my $amount = $params{amount}; + 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}; + + 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; + + 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; +} sub format_string { $main::lxdebug->enter_sub(2); @@ -787,6 +1020,8 @@ sub format_string { return $input; } +# + sub parse_amount { $main::lxdebug->enter_sub(2); @@ -870,9 +1105,6 @@ sub parse_template { map({ $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns)); - map({ $self->{"employee_${_}"} =~ s/\\n/\n/g; } - qw(company address signature)); - map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature)); map({ $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid)); @@ -927,14 +1159,15 @@ sub parse_template { $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email}; $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; $mail->{fileid} = "$fileid."; - $myconfig->{signature} =~ s/\\r\\n/\\n/g; + $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\n/
\n/g; - $myconfig->{signature} =~ s/\\n/
\n/g; + $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}) @@ -954,9 +1187,8 @@ sub parse_template { $self->{"attachment_filename"} : $self->{"tmpfile"} }); } - $mail->{message} =~ s/\r\n/\n/g; - $myconfig->{signature} =~ s/\\n/\n/g; - $mail->{message} .= "\n-- \n$myconfig->{signature}"; + $mail->{message} =~ s/\r//g; + $mail->{message} .= "\n-- \n$myconfig->{signature}"; } @@ -1042,7 +1274,7 @@ sub get_formname_translation { sub generate_attachment_filename { my ($self) = @_; - my $attachment_filename = $self->get_formname_translation(); + my $attachment_filename = $self->unquote_html($self->get_formname_translation()); my $prefix = (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv" : ($self->{"type"} =~ /_quotation$/) ? "quo" @@ -1621,8 +1853,6 @@ sub get_salesman { $self->{salesman_name} = $login if ($self->{salesman_name} eq ""); - - map({ $self->{"salesman_$_"} =~ s/\\n/\n/g; } qw(address company)); } $main::lxdebug->leave_sub(); @@ -1795,7 +2025,7 @@ sub _get_employees { my ($self, $dbh, $default_key, $key) = @_; $key = $default_key unless ($key); - $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY name|); + $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|); $main::lxdebug->leave_sub(); } @@ -1911,14 +2141,86 @@ sub _get_departments { $main::lxdebug->leave_sub(); } -sub _get_price_factors { +sub _get_warehouses { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $param) = @_; + + my ($key, $bins_key, $q_access, @values); + + if ('' eq ref $param) { + $key = $param; + } else { + $key = $param->{key}; + $bins_key = $param->{bins}; + + if ($param->{access}) { + $q_access = + qq| AND EXISTS ( + SELECT wa.employee_id + FROM warehouse_access wa + WHERE (wa.employee_id = (SELECT id FROM employee WHERE login = ?)) + AND (wa.warehouse_id = w.id) + AND (wa.access IN ('ro', 'rw')))|; + push @values, $param->{access}; + } + + if ($param->{no_personal}) { + $q_access .= qq| AND (w.personal_warehouse_of IS NULL)|; + + } elsif ($param->{personal}) { + $q_access .= qq| AND (w.personal_warehouse_of = ?)|; + push @values, conv_i($param->{personal}); + } + } + + 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) + $q_access + ORDER BY w.sortkey|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values); + + 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); + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + +sub _get_groups { $main::lxdebug->enter_sub(); my ($self, $dbh, $key) = @_; - $key ||= "all_price_factors"; + $key ||= "all_groups"; - my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|; + my $groups = $main::auth->read_groups(); $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -2016,7 +2318,15 @@ sub get_lists { } if ($params{price_factors}) { - $self->_get_price_factors($dbh, $params{price_factors}); + $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey'); + } + + if ($params{warehouses}) { + $self->_get_warehouses($dbh, $params{warehouses}); + } + + if ($params{groups}) { + $self->_get_groups($dbh, $params{groups}); } $main::lxdebug->leave_sub();