Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 8b39e389

Von Moritz Bunkus vor fast 14 Jahren hinzugefügt

  • ID 8b39e3893d7e9061c0e8142aca681c90f137bf30
  • Vorgänger a1d1605e
  • Nachfolger 35636cc2

Funktion "process_perl_script" von User.pm nach DBUpgrade2.pm verschoben

Unterschiede anzeigen:

SL/DBUpgrade2.pm
204 204
  $main::lxdebug->leave_sub();
205 205
}
206 206

  
207
# Process a Perl script which updates the database.
208
# If the script returns 1 then the update was successful.
209
# Return code "2" means "needs more interaction; remove
210
# users/nologin and end current request".
211
# All other return codes are fatal errors.
212
sub process_perl_script {
213
  $main::lxdebug->enter_sub();
214

  
215
  my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_;
216

  
217
  my $form         = $self->{form};
218
  my $fh           = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
219
  my $file_charset = Common::DEFAULT_CHARSET;
220

  
221
  if (ref($version_or_control) eq "HASH") {
222
    $file_charset = $version_or_control->{charset};
223

  
224
  } else {
225
    while (<$fh>) {
226
      last if !/^--/;
227
      next if !/^--\s*\@charset:\s*(.+)/;
228
      $file_charset = $1;
229
      last;
230
    }
231
    $fh->seek(0, SEEK_SET);
232
  }
233

  
234
  my $contents = join "", <$fh>;
235
  $fh->close();
236

  
237
  $db_charset ||= Common::DEFAULT_CHARSET;
238

  
239
  my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
240

  
241
  $dbh->begin_work();
242

  
243
  # setup dbup_ export vars
244
  my %dbup_myconfig = ();
245
  map({ $dbup_myconfig{$_} = $form->{$_}; } qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
246

  
247
  my $dbup_locale = $::locale;
248

  
249
  my $result = eval($contents);
250

  
251
  if (1 != $result) {
252
    $dbh->rollback();
253
    $dbh->disconnect();
254
  }
255

  
256
  if (!defined($result)) {
257
    print $form->parse_html_template("dbupgrade/error",
258
                                     { "file"  => $filename,
259
                                       "error" => $@ });
260
    ::end_of_request();
261
  } elsif (1 != $result) {
262
    unlink("users/nologin") if (2 == $result);
263
    ::end_of_request();
264
  }
265

  
266
  if (ref($version_or_control) eq "HASH") {
267
    $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
268
             $dbh->quote($version_or_control->{"tag"}) . ", " .
269
             $dbh->quote($form->{"login"}) . ")");
270
  } elsif ($version_or_control) {
271
    $dbh->do("UPDATE defaults SET version = " .
272
             $dbh->quote($version_or_control));
273
  }
274
  $dbh->commit();
275

  
276
  $main::lxdebug->leave_sub();
277
}
278

  
207 279
sub _check_for_loops {
208 280
  my ($form, $file_name, $controls, $tag, @path) = @_;
209 281

  

Auch abrufbar als: Unified diff