Revision 8e6eda05
Von Moritz Bunkus vor mehr als 17 Jahren hinzugefügt
SL/User.pm | ||
---|---|---|
48 | 48 |
my $self = {}; |
49 | 49 |
|
50 | 50 |
if ($login ne "") { |
51 |
local *MEMBER; |
|
52 |
|
|
53 |
$login =~ s|.*/||; |
|
54 |
|
|
51 | 55 |
&error("", "$memfile locked!") if (-f "${memfile}.LCK"); |
52 | 56 |
|
53 | 57 |
open(MEMBER, "$memfile") or &error("", "$memfile : $!"); |
... | ... | |
55 | 59 |
while (<MEMBER>) { |
56 | 60 |
if (/^\[$login\]/) { |
57 | 61 |
while (<MEMBER>) { |
58 |
last if /^\[/; |
|
59 |
next if /^(#|\s)/; |
|
62 |
last if m/^\[/;
|
|
63 |
next if m/^(#|\s)/;
|
|
60 | 64 |
|
61 | 65 |
# remove comments |
62 | 66 |
s/\s#.*//g; |
... | ... | |
88 | 92 |
sub country_codes { |
89 | 93 |
$main::lxdebug->enter_sub(); |
90 | 94 |
|
95 |
local *DIR; |
|
96 |
|
|
91 | 97 |
my %cc = (); |
92 | 98 |
my @language = (); |
93 | 99 |
|
... | ... | |
116 | 122 |
|
117 | 123 |
my ($self, $form, $userspath) = @_; |
118 | 124 |
|
125 |
local *FH; |
|
126 |
|
|
119 | 127 |
my $rc = -3; |
120 | 128 |
|
121 | 129 |
if ($self->{login}) { |
... | ... | |
134 | 142 |
} |
135 | 143 |
|
136 | 144 |
unless (-e "$userspath/$self->{login}.conf") { |
137 |
$self->create_config("$userspath/$self->{login}.conf");
|
|
145 |
$self->create_config(); |
|
138 | 146 |
} |
139 | 147 |
|
140 | 148 |
do "$userspath/$self->{login}.conf"; |
... | ... | |
207 | 215 |
$self->dbupdate($form); |
208 | 216 |
$self->dbupdate2($form, $controls); |
209 | 217 |
|
218 |
close(FH); |
|
219 |
|
|
210 | 220 |
# remove lock file |
211 | 221 |
unlink("$userspath/nologin"); |
212 | 222 |
|
... | ... | |
616 | 626 |
|
617 | 627 |
my ($self, $form, $memfile) = @_; |
618 | 628 |
|
629 |
local *FH; |
|
630 |
|
|
619 | 631 |
my @dbexcl = (); |
620 | 632 |
my @dbsources = (); |
621 | 633 |
|
... | ... | |
779 | 791 |
sub update_available { |
780 | 792 |
my ($dbdriver, $cur_version) = @_; |
781 | 793 |
|
794 |
local *SQLDIR; |
|
795 |
|
|
782 | 796 |
opendir(SQLDIR, "sql/${dbdriver}-upgrade") |
783 | 797 |
or &error("", "sql/${dbdriver}-upgrade: $!"); |
784 | 798 |
my @upgradescripts = |
... | ... | |
814 | 828 |
|
815 | 829 |
my ($self, $form) = @_; |
816 | 830 |
|
831 |
local *SQLDIR; |
|
832 |
|
|
817 | 833 |
$form->{sid} = $form->{dbdefault}; |
818 | 834 |
|
819 | 835 |
my @upgradescripts = (); |
... | ... | |
1008 | 1024 |
sub create_config { |
1009 | 1025 |
$main::lxdebug->enter_sub(); |
1010 | 1026 |
|
1011 |
my ($self, $filename) = @_; |
|
1027 |
my ($self) = @_; |
|
1028 |
|
|
1029 |
local *CONF; |
|
1012 | 1030 |
|
1013 |
@config = &config_vars;
|
|
1031 |
@config = config_vars();
|
|
1014 | 1032 |
|
1015 |
open(CONF, ">$filename") or $self->error("$filename : $!");
|
|
1033 |
open(CONF, ">", "$userspath/$self->{login}.conf") || $self->error("$userspath/$self->{login}.conf : $!");
|
|
1016 | 1034 |
|
1017 | 1035 |
# create the config file |
1018 | 1036 |
print CONF qq|# configuration file for $self->{login} |
... | ... | |
1020 | 1038 |
\%myconfig = ( |
1021 | 1039 |
|; |
1022 | 1040 |
|
1023 |
foreach $key (sort @config) { |
|
1041 |
foreach my $key (sort @config) {
|
|
1024 | 1042 |
$self->{$key} =~ s/\'/\\\'/g; |
1025 | 1043 |
print CONF qq| $key => '$self->{$key}',\n|; |
1026 | 1044 |
} |
... | ... | |
1037 | 1055 |
|
1038 | 1056 |
my ($self, $memberfile, $userspath) = @_; |
1039 | 1057 |
|
1058 |
local (*FH, *CONF); |
|
1059 |
|
|
1040 | 1060 |
my $newmember = 1; |
1041 | 1061 |
|
1042 | 1062 |
# format dbconnect and dboptions string |
... | ... | |
1110 | 1130 |
unlink "${memberfile}.LCK"; |
1111 | 1131 |
|
1112 | 1132 |
# create conf file |
1113 |
$self->create_config("$userspath/$self->{login}.conf") |
|
1114 |
unless $self->{'root login'}; |
|
1133 |
$self->create_config() unless $self->{'root login'}; |
|
1115 | 1134 |
|
1116 | 1135 |
$main::lxdebug->leave_sub(); |
1117 | 1136 |
} |
Auch abrufbar als: Unified diff
Filehandles lokal deklarieren. open() nur mit "sicherem" Argument aufrufen.