Revision 8c7e4493
Von Moritz Bunkus vor fast 17 Jahren hinzugefügt
| SL/AM.pm | ||
|---|---|---|
| 37 | 37 |
|
| 38 | 38 |
package AM; |
| 39 | 39 |
|
| 40 |
use Carp; |
|
| 40 | 41 |
use Data::Dumper; |
| 41 | 42 |
use SL::DBUtils; |
| 42 | 43 |
|
| ... | ... | |
| 1528 | 1529 |
sub save_preferences {
|
| 1529 | 1530 |
$main::lxdebug->enter_sub(); |
| 1530 | 1531 |
|
| 1531 |
my ($self, $myconfig, $form, $memberfile, $userspath, $webdav) = @_;
|
|
| 1532 |
my ($self, $myconfig, $form, $webdav) = @_; |
|
| 1532 | 1533 |
|
| 1533 | 1534 |
my $dbh = $form->get_standard_dbh($myconfig); |
| 1534 | 1535 |
|
| ... | ... | |
| 1546 | 1547 |
|
| 1547 | 1548 |
$form->{businessnumber} = $businessnumber;
|
| 1548 | 1549 |
|
| 1549 |
$myconfig = new User "$memberfile", "$form->{login}";
|
|
| 1550 |
my $myconfig = new User($form->{login});
|
|
| 1550 | 1551 |
|
| 1551 | 1552 |
foreach my $item (keys %$form) {
|
| 1552 | 1553 |
$myconfig->{$item} = $form->{$item};
|
| 1553 | 1554 |
} |
| 1554 | 1555 |
|
| 1555 |
$myconfig->save_member($memberfile, $userspath); |
|
| 1556 |
$myconfig->save_member($memberfile); |
|
| 1557 |
|
|
| 1558 |
my $auth = $main::auth; |
|
| 1559 |
|
|
| 1560 |
if ($auth->can_change_password() |
|
| 1561 |
&& defined $form->{new_password}
|
|
| 1562 |
&& ($form->{new_password} ne '********')) {
|
|
| 1563 |
$auth->change_password($form->{login}, $form->{new_password});
|
|
| 1564 |
|
|
| 1565 |
$form->{password} = $form->{new_password};
|
|
| 1566 |
$auth->set_session_value('password', $form->{password});
|
|
| 1567 |
$auth->create_or_refresh_session(); |
|
| 1568 |
} |
|
| 1556 | 1569 |
|
| 1557 | 1570 |
if ($webdav) {
|
| 1558 | 1571 |
@webdavdirs = |
| ... | ... | |
| 1820 | 1833 |
return $units; |
| 1821 | 1834 |
} |
| 1822 | 1835 |
|
| 1836 |
sub retrieve_all_units {
|
|
| 1837 |
$main::lxdebug->enter_sub(); |
|
| 1838 |
|
|
| 1839 |
my $self = shift; |
|
| 1840 |
|
|
| 1841 |
if (!$main::all_units) {
|
|
| 1842 |
$main::all_units = $self->retrieve_units(\%main::myconfig, $main::form); |
|
| 1843 |
} |
|
| 1844 |
|
|
| 1845 |
$main::lxdebug->leave_sub(); |
|
| 1846 |
|
|
| 1847 |
return $main::all_units; |
|
| 1848 |
} |
|
| 1849 |
|
|
| 1850 |
|
|
| 1823 | 1851 |
sub translate_units {
|
| 1824 | 1852 |
$main::lxdebug->enter_sub(); |
| 1825 | 1853 |
|
| ... | ... | |
| 1889 | 1917 |
$main::lxdebug->leave_sub(); |
| 1890 | 1918 |
} |
| 1891 | 1919 |
|
| 1920 |
sub convertible_units {
|
|
| 1921 |
$main::lxdebug->enter_sub(); |
|
| 1922 |
|
|
| 1923 |
my $self = shift; |
|
| 1924 |
my $units = shift; |
|
| 1925 |
my $filter_unit = shift; |
|
| 1926 |
my $not_smaller = shift; |
|
| 1927 |
|
|
| 1928 |
my $conv_units = []; |
|
| 1929 |
|
|
| 1930 |
$filter_unit = $units->{$filter_unit};
|
|
| 1931 |
|
|
| 1932 |
foreach my $name (sort { lc $a cmp lc $b } keys %{ $units }) {
|
|
| 1933 |
my $unit = $units->{$name};
|
|
| 1934 |
|
|
| 1935 |
if (($unit->{base_unit} eq $filter_unit->{base_unit}) &&
|
|
| 1936 |
(!$not_smaller || ($unit->{factor} >= $filter_unit->{factor}))) {
|
|
| 1937 |
push @{$conv_units}, $unit;
|
|
| 1938 |
} |
|
| 1939 |
} |
|
| 1940 |
|
|
| 1941 |
my @sorted = sort { $b->{factor} <=> $a->{factor} } @{ $conv_units };
|
|
| 1942 |
|
|
| 1943 |
$main::lxdebug->leave_sub(); |
|
| 1944 |
|
|
| 1945 |
return \@sorted; |
|
| 1946 |
} |
|
| 1947 |
|
|
| 1892 | 1948 |
# if $a is translatable to $b, return the factor between them. |
| 1893 | 1949 |
# else return 1 |
| 1894 | 1950 |
sub convert_unit {
|
| ... | ... | |
| 1903 | 1959 |
sub unit_select_data {
|
| 1904 | 1960 |
$main::lxdebug->enter_sub(); |
| 1905 | 1961 |
|
| 1906 |
my ($self, $units, $selected, $empty_entry) = @_; |
|
| 1962 |
my ($self, $units, $selected, $empty_entry, $convertible_into) = @_;
|
|
| 1907 | 1963 |
|
| 1908 | 1964 |
my $select = []; |
| 1909 | 1965 |
|
| ... | ... | |
| 1912 | 1968 |
} |
| 1913 | 1969 |
|
| 1914 | 1970 |
foreach my $unit (sort({ $units->{$a}->{"sortkey"} <=> $units->{$b}->{"sortkey"} } keys(%{$units}))) {
|
| 1915 |
push(@{$select}, { "name" => $unit,
|
|
| 1916 |
"base_unit" => $units->{$unit}->{"base_unit"},
|
|
| 1917 |
"factor" => $units->{$unit}->{"factor"},
|
|
| 1918 |
"selected" => ($unit eq $selected) ? "selected" : "" }); |
|
| 1971 |
if (!$convertible_into || |
|
| 1972 |
($units->{$convertible_into} &&
|
|
| 1973 |
($units->{$convertible_into}->{base_unit} eq $units->{$unit}->{base_unit}))) {
|
|
| 1974 |
push @{$select}, { "name" => $unit,
|
|
| 1975 |
"base_unit" => $units->{$unit}->{"base_unit"},
|
|
| 1976 |
"factor" => $units->{$unit}->{"factor"},
|
|
| 1977 |
"selected" => ($unit eq $selected) ? "selected" : "" }; |
|
| 1978 |
} |
|
| 1919 | 1979 |
} |
| 1920 | 1980 |
|
| 1921 | 1981 |
$main::lxdebug->leave_sub(); |
| ... | ... | |
| 1944 | 2004 |
return $select; |
| 1945 | 2005 |
} |
| 1946 | 2006 |
|
| 2007 |
sub sum_with_unit {
|
|
| 2008 |
$main::lxdebug->enter_sub(); |
|
| 2009 |
|
|
| 2010 |
my $self = shift; |
|
| 2011 |
|
|
| 2012 |
my $units = $self->retrieve_all_units(); |
|
| 2013 |
|
|
| 2014 |
my $sum = 0; |
|
| 2015 |
my $base_unit; |
|
| 2016 |
|
|
| 2017 |
while (2 <= scalar(@_)) {
|
|
| 2018 |
my $qty = shift(@_); |
|
| 2019 |
my $unit = $units->{shift(@_)};
|
|
| 2020 |
|
|
| 2021 |
croak "No unit defined with name $unit" if (!defined $unit); |
|
| 2022 |
|
|
| 2023 |
if (!$base_unit) {
|
|
| 2024 |
$base_unit = $unit->{base_unit};
|
|
| 2025 |
} elsif ($base_unit ne $unit->{base_unit}) {
|
|
| 2026 |
croak "Adding values with incompatible base units $base_unit/$unit->{base_unit}";
|
|
| 2027 |
} |
|
| 2028 |
|
|
| 2029 |
$sum += $qty * $unit->{factor};
|
|
| 2030 |
} |
|
| 2031 |
|
|
| 2032 |
$main::lxdebug->leave_sub(); |
|
| 2033 |
|
|
| 2034 |
return wantarray ? ($sum, $baseunit) : $sum; |
|
| 2035 |
} |
|
| 2036 |
|
|
| 1947 | 2037 |
sub add_unit {
|
| 1948 | 2038 |
$main::lxdebug->enter_sub(); |
| 1949 | 2039 |
|
Auch abrufbar als: Unified diff
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.