/SL/Form.pm - Diff - projekt kivitendo - wissen

« Zurück | Weiter »

Revision 8c7e4493

Von Moritz Bunkus vor fast 17 Jahren hinzugefügt

ID 8c7e44938a661e035f62840e1e177353240ace5d
Vorgänger 3ced230b
Nachfolger ce45d060

Umstellung der Benutzerverwaltung von Dateien im Verzeichnis "users" auf die Verwendung einer Authentifizierungsdatenbank.
Es ist erforderlich, die Dateien doc/UPGRADE und doc/INSTALL/index.html zu lesen und die angesprochenen Punkte auszuführen, um nach einem Upgrade weiter arbeiten zu können.

     package Form;
     use Data::Dumper;
     use Cwd;
     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;
-...
       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 {
       $main::lxdebug->enter_sub();
-...
       $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);
-...
       my ($self, $str) = @_;
       my %replace =
         ('order' => ['"', '<', '>'],
          '<'             => '&lt;',
          '>'             => '&gt;',
          '"'             => '&quot;',
         ('order' => ['&', '"', '<', '>'],
          '<'     => '&lt;',
          '>'     => '&gt;',
          '"'     => '&quot;',
          '&'     => '&amp;',
         );
       map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} });
-...
       return $str;
+    }
     sub unquote_html {
       $main::lxdebug->enter_sub(2);
       my ($self, $str) = @_;
       my %replace  =
         ('&auml;'  => '?',
          '&ouml;'  => '?',
          '&uuml;'  => '?',
          '&Auml;'  => '?',
          '&Ouml;'  => '?',
          '&Uuml;'  => '?',
          '&szlig;' => '?',
          '&gt;'    => '>',
          '&lt;'    => '<',
          '&quot;'  => '"',
         );
       map { $str =~ s/\Q$_\E/$replace{$_}/g; } keys %replace;
       $str =~ s/\&amp;/\&/g;
       $main::lxdebug->leave_sub(2);
       return $str;
+    }
     sub hide_form {
       my $self = shift;
-...
     # 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 {
-...
         return;
+      }
       my $cgi   = $main::cgi;
       $cgi    ||= CGI->new('');
       my ($stylesheet, $favicon);
       if ($ENV{HTTP_USER_AGENT}) {
-...
         foreach $item (@ { $self->{AJAX} }) {
           $ajax .= $item->show_javascript();
+        }
         print qq|Content-Type: text/html; charset=${db_charset};
     ${doctype}<html>
         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}<html>
     <head>
       <title>$self->{titlebar}</title>
       $stylesheet
-...
         map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
+      }
       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;
+        }
+      }
       $main::lxdebug->leave_sub();
       return $file;
-...
       $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);
-...
       return $input;
+    }
+    #
     sub parse_amount {
       $main::lxdebug->enter_sub(2);
-...
       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));
-...
           $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/<br>\n/g;
             $myconfig->{signature} =~ s/\\n/<br>\n/g;
             $mail->{message}       =~ s/\r//g;
             $mail->{message}       =~ s/\n/<br>\n/g;
             $myconfig->{signature} =~ s/\n/<br>\n/g;
             $mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
             open(IN, $self->{tmpfile})
-...
                      $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}";
+          }
-...
     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"
-...
         $self->{salesman_name} = $login
           if ($self->{salesman_name} eq "");
         map({ $self->{"salesman_$_"} =~ s/\\n/\n/g; } qw(address company));
+      }
       $main::lxdebug->leave_sub();
-...
       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();
+    }
-...
       $main::lxdebug->leave_sub();
+    }
     sub _get_price_factors {
     sub _get_warehouses {
       $main::lxdebug->enter_sub();
       my ($self, $dbh, $key) = @_;
       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);
       $key ||= "all_price_factors";
       if ($bins_key) {
         $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|;
         my $sth = prepare_query($self, $dbh, $query);
       my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|;
         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);
-...
+      }
       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});
+      }
       $main::lxdebug->leave_sub();

Auch abrufbar als: Unified diff

Projekt

Allgemein

Profil

projekt kivitendo

Revision 8c7e4493

Von Moritz Bunkus vor fast 17 Jahren hinzugefügt