mini-DMS: Filesystem-Backend: ungeänderte Dokumente nicht doppelt speichern.
[kivitendo-erp.git] / SL / DBUpgrade2 / Base.pm
index 100652e..cd698c5 100644 (file)
@@ -11,6 +11,9 @@ use File::Basename ();
 use File::Copy ();
 use File::Path ();
 use List::MoreUtils qw(uniq);
 use File::Copy ();
 use File::Path ();
 use List::MoreUtils qw(uniq);
+use SL::DBUtils qw(selectfirst_hashref_query);
+use SL::Presenter::EscapedText qw(escape);
+use version;
 
 use Rose::Object::MakeMethods::Generic (
   scalar => [ qw(dbh myconfig) ],
 
 use Rose::Object::MakeMethods::Generic (
   scalar => [ qw(dbh myconfig) ],
@@ -28,9 +31,10 @@ sub execute_script {
     die $EVAL_ERROR;
   }
 
     die $EVAL_ERROR;
   }
 
+  my $auth    =  $file_name =~ m{/Pg-upgrade2-auth/} ? 'Auth::' : '';
   my $package =  delete $params{tag};
   $package    =~ s/[^a-zA-Z0-9_]+/_/g;
   my $package =  delete $params{tag};
   $package    =~ s/[^a-zA-Z0-9_]+/_/g;
-  $package    =  "SL::DBUpgrade2::${package}";
+  $package    =  "SL::DBUpgrade2::${auth}${package}";
 
   $package->new(%params)->run;
 }
 
   $package->new(%params)->run;
 }
@@ -57,8 +61,14 @@ sub db_query {
 sub db_errstr {
   my ($self, $handle) = @_;
 
 sub db_errstr {
   my ($self, $handle) = @_;
 
+  # DBD::Pg before 2.16.1 doesn't set the UTF-8 flag for error
+  # messages even if the connection has UTF-8 enabled. Therefore we
+  # have to convert it to Perl's internal encoding ourselves. See
+  # https://rt.cpan.org/Public/Bug/Display.html?id=53854
+
   my $error = $handle ? $handle->errstr : $self->dbh->errstr;
 
   my $error = $handle ? $handle->errstr : $self->dbh->errstr;
 
+  return $error if version->new("$DBD::Pg::VERSION")->numify >= version->new("2.16.1")->numify;
   return Encode::decode('utf-8', $error);
 }
 
   return Encode::decode('utf-8', $error);
 }
 
@@ -90,11 +100,11 @@ sub add_print_templates {
     croak "File '${src_dir}/$_' does not exist" unless -f "${src_dir}/$_";
   }
 
     croak "File '${src_dir}/$_' does not exist" unless -f "${src_dir}/$_";
   }
 
-  my $template_dir = $::instance_conf->reload->get_templates;
+  # can't use Rose or InstanceConf here because defaults might not be fully upgraded yet.
+  my $defaults = selectfirst_hashref_query($::form, $::form->get_standard_dbh, "SELECT * FROM defaults");
+  return 1 unless my $template_dir = $defaults->{template};
   $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: template_dir $template_dir");
 
   $::lxdebug->message(LXDebug::DEBUG1(), "add_print_templates: template_dir $template_dir");
 
-  return 1 if !$template_dir;
-
   foreach my $src_file (@files) {
     my $dest_file = $template_dir . '/' . $src_file;
 
   foreach my $src_file (@files) {
     my $dest_file = $template_dir . '/' . $src_file;
 
@@ -135,6 +145,26 @@ SQL
   $self->db_query(qq|ALTER TABLE $params{schema}."$params{table}" DROP CONSTRAINT "${_}"|) for map { $_->[0] } @{ $constraints };
 }
 
   $self->db_query(qq|ALTER TABLE $params{schema}."$params{table}" DROP CONSTRAINT "${_}"|) for map { $_->[0] } @{ $constraints };
 }
 
+sub convert_column_to_html {
+  my ($self, $table, $column) = @_;
+
+  my $sth = $self->dbh->prepare(qq|UPDATE $table SET $column = ? WHERE id = ?|) || $self->dberror;
+
+  foreach my $row (selectall_hashref_query($::form, $self->dbh, qq|SELECT id, $column FROM $table WHERE $column IS NOT NULL|)) {
+    next if !$row->{$column} || (($row->{$column} =~ m{^<[a-z]+>}) && ($row->{$column} =~ m{</[a-z]+>$}));
+
+    my $new_content = "" . escape($row->{$column});
+    $new_content    =~ s{\r}{}g;
+    $new_content    =~ s{\n\n+}{</p><p>}g;
+    $new_content    =~ s{\n}{<br />}g;
+    $new_content    =  "<p>${new_content}</p>" if $new_content;
+
+    $sth->execute($new_content, $row->{id}) if $new_content ne $row->{$column};
+  }
+
+  $sth->finish;
+}
+
 1;
 __END__
 
 1;
 __END__
 
@@ -258,8 +288,10 @@ be used.
 =item C<db_errstr [$handle]>
 
 Returns the last database from C<$handle> error message encoded in
 =item C<db_errstr [$handle]>
 
 Returns the last database from C<$handle> error message encoded in
-Perl's internal encoding. The PostgreSQL DBD leaves the UTF-8 flag off
-for error messages even if the C<pg_enable_utf8> attribute is set.
+Perl's internal encoding. The PostgreSQL DBD before 2.16.1 leaves the
+UTF-8 flag off for error messages even if the C<pg_enable_utf8>
+attribute is set. For older versions the error string is already
+encoded correctly and is left unchanged.
 
 C<$handle> is optional and can be one of three things:
 
 
 C<$handle> is optional and can be one of three things:
 
@@ -307,6 +339,11 @@ C<acc_trans> yet.
 This method is the entry point for the actual upgrade. Each upgrade
 script must provide this method.
 
 This method is the entry point for the actual upgrade. Each upgrade
 script must provide this method.
 
+=item C<convert_column_to_html $table, $column>
+
+Converts the content of a single column from text to HTML suitable for
+use with the ckeditor.
+
 =back
 
 =head1 BUGS
 =back
 
 =head1 BUGS