Auftrags-Controller: Speichern und schließen, …
[kivitendo-erp.git] / scripts / rose_auto_create_model.pl
index b23a75d..2ab34cb 100755 (executable)
@@ -3,8 +3,10 @@
 use strict;
 
 BEGIN {
 use strict;
 
 BEGIN {
-  unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
-  push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
+  use FindBin;
+
+  unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML).
+  push   (@INC, $FindBin::Bin . '/..');                  # '.' will be removed from @INC soon.
 }
 
 use CGI qw( -no_xhtml);
 }
 
 use CGI qw( -no_xhtml);
@@ -13,20 +15,25 @@ use Data::Dumper;
 use Digest::MD5 qw(md5_hex);
 use English qw( -no_match_vars );
 use Getopt::Long;
 use Digest::MD5 qw(md5_hex);
 use English qw( -no_match_vars );
 use Getopt::Long;
-use List::MoreUtils qw(any);
+use List::MoreUtils qw(apply none uniq);
+use List::UtilsBy qw(partition_by);
 use Pod::Usage;
 use Pod::Usage;
+use Rose::DB::Object 0.809;
 use Term::ANSIColor;
 
 use SL::Auth;
 use SL::DBUtils;
 use SL::DB;
 use SL::Form;
 use Term::ANSIColor;
 
 use SL::Auth;
 use SL::DBUtils;
 use SL::DB;
 use SL::Form;
+use SL::InstanceConfiguration;
 use SL::Locale;
 use SL::LXDebug;
 use SL::LxOfficeConf;
 use SL::DB::Helper::ALL;
 use SL::DB::Helper::Mappings;
 
 use SL::Locale;
 use SL::LXDebug;
 use SL::LxOfficeConf;
 use SL::DB::Helper::ALL;
 use SL::DB::Helper::Mappings;
 
+chdir($FindBin::Bin . '/..');
+
 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
 my %package_names = SL::DB::Helper::Mappings->get_package_names;
 
 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
 my %package_names = SL::DB::Helper::Mappings->get_package_names;
 
@@ -35,74 +42,182 @@ our $auth;
 our %lx_office_conf;
 
 our $script =  __FILE__;
 our %lx_office_conf;
 
 our $script =  __FILE__;
-$script     =~ s:.*/::;
+$script     =~ s{.*/}{};
 
 $OUTPUT_AUTOFLUSH       = 1;
 $Data::Dumper::Sortkeys = 1;
 
 
 $OUTPUT_AUTOFLUSH       = 1;
 $Data::Dumper::Sortkeys = 1;
 
-our $meta_path = "SL/DB/MetaSetup";
+our $meta_path    = "SL/DB/MetaSetup";
+our $manager_path = "SL/DB/Manager";
 
 my %config;
 
 
 my %config;
 
+# Maps column names in tables to foreign key relationship names.  For
+# example:
+#
+# »follow_up_access« contains a column named »who«. Rose normally
+# names the resulting relationship after the class the target table
+# uses. In this case the target table is »employee« and the
+# corresponding class SL::DB::Employee. The resulting relationship
+# would be named »employee«.
+#
+# In order to rename this relationship we have to map »who« to
+# e.g. »granted_by«:
+#   follow_up_access => { who => 'granted_by' },
+
+our %foreign_key_name_map     = (
+  KIVITENDO                   => {
+    oe                        => { payment_id => 'payment_terms', },
+    ar                        => { payment_id => 'payment_terms', },
+    ap                        => { payment_id => 'payment_terms', },
+
+    orderitems                => { parts_id => 'part', trans_id => 'order', },
+    delivery_order_items      => { parts_id => 'part' },
+    invoice                   => { parts_id => 'part' },
+    follow_ups                => { created_for_user => 'created_for_employee', created_by => 'created_by_employee', },
+    follow_up_access          => { who => 'with_access', what => 'to_follow_ups_by', },
+
+    periodic_invoices_configs => { oe_id => 'order', email_recipient_contact_id => 'email_recipient_contact' },
+    reconciliation_links      => { acc_trans_id => 'acc_trans' },
+
+    assembly                  => { parts_id => 'part', id => 'assembly_part' },
+    assortment_items          => { parts_id => 'part' },
+
+    dunning                   => { trans_id => 'invoice', fee_interest_ar_id => 'fee_interest_invoice' },
+  },
+);
+
 sub setup {
 
   SL::LxOfficeConf->read;
 
 sub setup {
 
   SL::LxOfficeConf->read;
 
-  my $login     = $config{login} || $::lx_office_conf{devel}{login};
+  my $client     = $config{client} || $::lx_office_conf{devel}{client};
+  my $new_client = $config{new_client};
+
+  if (!$client && !$new_client) {
+    error("No client found in config. Please provide a client:");
+    usage();
+  }
+
+  $::lxdebug       = LXDebug->new();
+  $::lxdebug->disable_sub_tracing;
+  $::locale        = Locale->new("de");
+  $::form          = new Form;
+  $::instance_conf = SL::InstanceConfiguration->new;
+  $form->{script}  = 'rose_meta_data.pl';
+
+  if ($new_client) {
+    $::auth       = SL::Auth->new(unit_tests_database => 1);
+    $client       = 1;
+    drop_and_create_test_database();
+  } else {
+    $::auth       = SL::Auth->new();
+  }
 
 
-  if (!$login) {
-    error("No login found in config. Please provide a login:");
+  if (!$::auth->set_client($client)) {
+    error("No client with ID or name '$client' found in config. Please provide a client:");
     usage();
   }
 
     usage();
   }
 
-  $::lxdebug      = LXDebug->new();
-  $::locale       = Locale->new("de");
-  $::form         = new Form;
-  $::auth         = SL::Auth->new();
-  $::user         = User->new(login => $login);
-  %::myconfig     = $auth->read_user(login => $login);
-  $::request      = { cgi => CGI->new({}) };
-  $form->{script} = 'rose_meta_data.pl';
-  $form->{login}  = $login;
+  foreach (($meta_path, $manager_path)) {
+    mkdir $_ unless -d;
+  }
+}
+
+sub fix_relationship_names {
+  my ($domain, $table, $fkey_text) = @_;
+
+  if ($fkey_text !~ m/key_columns \s+ => \s+ \{ \s+ ['"]? ( [^'"\s]+ ) /x) {
+    die "fix_relationship_names: could not extract the key column for domain/table $domain/$table; foreign key definition text:\n${fkey_text}\n";
+  }
+
+  my $column_name = $1;
+  my %changes     = map { %{$_} } grep { $_ } ($foreign_key_name_map{$domain}->{ALL}, $foreign_key_name_map{$domain}->{$table});
 
 
-  map { $form->{$_} = $::myconfig{$_} } qw(stylesheet charset);
+  if (my $desired_name = $changes{$column_name}) {
+    $fkey_text =~ s/^ \s\s [^\s]+ \b/  ${desired_name}/msx;
+  }
 
 
-  mkdir $meta_path unless -d $meta_path;
+  return $fkey_text;
 }
 
 sub process_table {
 }
 
 sub process_table {
-  my @spec       =  split(/=/, shift, 2);
-  my $table      =  $spec[0];
+  my ($domain, $table, $package) = @_;
   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
-  my $package    =  ucfirst($spec[1] || $spec[0]);
+  $package       =  ucfirst($package || $table);
   $package       =~ s/_+(.)/uc($1)/ge;
   my $meta_file  =  "${meta_path}/${package}.pm";
   $package       =~ s/_+(.)/uc($1)/ge;
   my $meta_file  =  "${meta_path}/${package}.pm";
+  my $mngr_file  =  "${manager_path}/${package}.pm";
   my $file       =  "SL/DB/${package}.pm";
 
   my $file       =  "SL/DB/${package}.pm";
 
-  $schema        = <<CODE if $schema;
-    __PACKAGE__->meta->schema('$schema');
+  my $schema_str = $schema ? <<CODE : '';
+__PACKAGE__->meta->schema('$schema');
 CODE
 
 CODE
 
-  my $definition =  eval <<CODE;
+  eval <<CODE;
     package SL::DB::AUTO::$package;
     package SL::DB::AUTO::$package;
-    use SL::DB::Object;
-    use base qw(SL::DB::Object);
+    use parent qw(SL::DB::Object);
 
     __PACKAGE__->meta->table('$table');
 
     __PACKAGE__->meta->table('$table');
-$schema
+    $schema_str
     __PACKAGE__->meta->auto_initialize;
 
     __PACKAGE__->meta->auto_initialize;
 
-    __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'
 CODE
 
   if ($EVAL_ERROR) {
     error("Error in execution for table '$table'");
 CODE
 
   if ($EVAL_ERROR) {
     error("Error in execution for table '$table'");
-    error("'$EVAL_ERROR'") if $config{verbose};
+    error("'$EVAL_ERROR'") unless $config{quiet};
     return;
   }
 
     return;
   }
 
+  my %args = (indent => 2, use_setup => 0);
+
+  my $definition =  "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
+  $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;
   $definition =~ s/::AUTO::/::/g;
   $definition =~ s/::AUTO::/::/g;
+
+
+  # Sort column definitions alphabetically
+  if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
+    my ($start, $end)  = ($-[1], $+[1]);
+    my $sorted_columns = join "\n", sort split m/\n/, $1;
+    substr $definition, $start, $end - $start, $sorted_columns;
+  }
+
+  # patch foreign keys
+  my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
+  $foreign_key_definition =~ s/::AUTO::/::/g;
+
+  if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
+    # These positions refer to the whole setup call, not just the
+    # parameters/actual relationship definitions.
+    my ($start, $end) = ($-[0], $+[0]);
+
+    # Match the function parameters = the actual relationship
+    # definitions
+    next unless $foreign_key_definition =~ m/\(\n(.+)\n\)/s;
+
+    my ($list_start, $list_end) = ($-[0], $+[0]);
+
+    # Split the whole chunk on double new lines. The resulting
+    # elements are one relationship each. Then fix the relationship
+    # names and sort them by their new names.
+    my @new_foreign_keys = sort map { fix_relationship_names($domain, $table, $_) } split m/\n\n/m, $1;
+
+    # Replace the function parameters = the actual relationship
+    # definitions with the new ones.
+    my $sorted_foreign_keys = "(\n" . join("\n\n", @new_foreign_keys) . "\n)";
+    substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;
+
+    # Replace the whole setup call in the auto-generated output with
+    # our new version.
+    substr $definition, $start, $end - $start, $foreign_key_definition;
+  }
+
+  $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
+  $definition =~ s{^use base}{use parent}m;
+
   my $full_definition = <<CODE;
 # This file has been auto-generated. Do not modify it; it will be overwritten
 # by $::script automatically.
   my $full_definition = <<CODE;
 # This file has been auto-generated. Do not modify it; it will be overwritten
 # by $::script automatically.
@@ -118,9 +233,9 @@ package SL::DB::${package};
 use strict;
 
 use SL::DB::MetaSetup::${package};
 use strict;
 
 use SL::DB::MetaSetup::${package};
+use SL::DB::Manager::${package};
 
 
-# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
-__PACKAGE__->meta->make_manager_class;
+__PACKAGE__->meta->initialize;
 
 1;
 CODE
 
 1;
 CODE
@@ -132,8 +247,8 @@ CODE
     my $old_md5     = md5_hex($orig_file);
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);
     my $old_md5     = md5_hex($orig_file);
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);
-    if ($old_size == $new_size && $old_md5 == $new_md5) {
-      notice("No changes in $meta_file, skipping.") if $config{verbose};
+    if ($old_size == $new_size && $old_md5 eq $new_md5) {
+      notice("No changes in $meta_file, skipping.") unless $config{quiet};
       return;
     }
 
       return;
     }
 
@@ -147,31 +262,60 @@ CODE
 
   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 
 
   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 
-  if (! -f $file) {
-    if (!$config{nocommit}) {
-      open my $out, ">", $file || die;
-      print $out $meta_definition;
-    }
+  return if -f $file;
+
+  if (!$config{nocommit}) {
+    open my $out, ">", $file || die;
+    print $out $meta_definition;
+  }
+
+  notice("File '$file' created as well.");
+
+  return if -f $mngr_file;
+
+  if (!$config{nocommit}) {
+    open my $out, ">", $mngr_file || die;
+    print $out <<EOT;
+# This file has been auto-generated only because it didn't exist.
+# Feel free to modify it at will; it will not be overwritten automatically.
+
+package SL::DB::Manager::${package};
+
+use strict;
+
+use parent qw(SL::DB::Helper::Manager);
+
+sub object_class { 'SL::DB::${package}' }
+
+__PACKAGE__->make_manager_methods;
 
 
-    notice("File '$file' created as well.");
+1;
+EOT
   }
   }
+
+  notice("File '$mngr_file' created as well.");
 }
 
 sub parse_args {
   my ($options) = @_;
   GetOptions(
 }
 
 sub parse_args {
   my ($options) = @_;
   GetOptions(
-    'login|user=s'      => \ my $login,
+    'client=s'          => \ my $client,
+    'test-client'       => \ my $use_test_client,
     all                 => \ my $all,
     all                 => \ my $all,
+    'db=s'              => \ my $db,
     'no-commit|dry-run' => \ my $nocommit,
     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
     'no-commit|dry-run' => \ my $nocommit,
     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
-    verbose             => \ my $verbose,
+    quiet               => \ my $quiet,
     diff                => \ my $diff,
   );
 
     diff                => \ my $diff,
   );
 
-  $options->{login}    = $login if $login;
-  $options->{all}      = $all;
-  $options->{nocommit} = $nocommit;
-  $options->{verbose}  = $verbose;
+  $options->{client}     = $client;
+  $options->{new_client} = $use_test_client;
+  $options->{all}        = $all;
+  $options->{db}         = $db;
+  $options->{nocommit}   = $nocommit;
+  $options->{quiet}      = $quiet;
+  $options->{color}      = -t STDOUT ? 1 : 0;
 
   if ($diff) {
     if (eval { require Text::Diff; 1 }) {
 
   if ($diff) {
     if (eval { require Text::Diff; 1 }) {
@@ -192,7 +336,11 @@ sub show_diff {
 
    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
      for (split /\n/, $_[0]) {
 
    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
      for (split /\n/, $_[0]) {
-       print colored($_, $colors{substr($_, 0, 1)}), $/;
+       if ($config{color}) {
+         print colored($_, $colors{substr($_, 0, 1)}), $/;
+       } else {
+         print $_, $/;
+       }
      }
    }});
 }
      }
    }});
 }
@@ -201,22 +349,49 @@ sub usage {
   pod2usage(verbose => 99, sections => 'SYNOPSIS');
 }
 
   pod2usage(verbose => 99, sections => 'SYNOPSIS');
 }
 
-sub make_tables {
+sub list_all_tables {
+  my ($db) = @_;
+
+  my @schemas = (undef, uniq apply { s{\..*}{} } grep { m{\.} } keys %{ $package_names{KIVITENDO} });
   my @tables;
   my @tables;
+
+  foreach my $schema (@schemas) {
+    $db->schema($schema);
+    push @tables, map { $schema ? "${schema}.${_}" : $_ } $db->list_tables;
+  }
+
+  $db->schema(undef);
+
+  return @tables;
+}
+
+sub make_tables {
+  my %tables_by_domain;
   if ($config{all}) {
   if ($config{all}) {
-    my $db  = SL::DB::create(undef, 'LXOFFICE');
-    @tables =
-      map { $package_names{LXOFFICE}->{$_} ? "$_=" . $package_names{LXOFFICE}->{$_} : $_ }
-      grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{LXOFFICE} } }
-      $db->list_tables;
+    my @domains = $config{db} ? (uc $config{db}) : sort keys %package_names;
+
+    foreach my $domain (@domains) {
+      my $db  = SL::DB::create(undef, $domain);
+      $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } list_all_tables($db) ];
+      $db->disconnect;
+    }
+
   } elsif (@ARGV) {
   } elsif (@ARGV) {
-    @tables = @ARGV;
+    %tables_by_domain = partition_by {
+      my ($domain, $table) = split m{:};
+      $table ? uc($domain) : 'KIVITENDO';
+    } @ARGV;
+
+    foreach my $tables (values %tables_by_domain) {
+      s{.*:}{} for @{ $tables };
+    }
+
   } else {
     error("You specified neither --all nor any specific tables.");
     usage();
   }
 
   } else {
     error("You specified neither --all nor any specific tables.");
     usage();
   }
 
-  @tables;
+  return %tables_by_domain;
 }
 
 sub error {
 }
 
 sub error {
@@ -227,15 +402,174 @@ sub notice {
   print @_, $/;
 }
 
   print @_, $/;
 }
 
+sub check_errors_in_package_names {
+  foreach my $domain (sort keys %package_names) {
+    my @both = grep { $package_names{$domain}->{$_} } @{ $blacklist{$domain} || [] };
+    next unless @both;
+
+    print "Error: domain '$domain': The following table names are present in both the black list and the package name hash: ", join(' ', sort @both), "\n";
+    exit 1;
+  }
+}
+
+sub drop_and_create_test_database {
+  my $db_cfg          = $::lx_office_conf{'testing/database'} || die 'testing/database missing';
+
+  my @dbi_options = (
+    'dbi:Pg:dbname=' . $db_cfg->{template} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
+    $db_cfg->{user},
+    $db_cfg->{password},
+    SL::DBConnect->get_options,
+  );
+
+  $::auth->reset;
+  my $dbh_template = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("No database connection to the template database: " . $DBI::errstr);
+  my $auth_dbh     = $::auth->dbconnect(1);
+
+  if ($auth_dbh) {
+    notice("Database exists; dropping");
+    $auth_dbh->disconnect;
+
+    dbh_do($dbh_template, "DROP DATABASE \"" . $db_cfg->{db} . "\"", message => "Database could not be dropped");
+  }
+
+  notice("Creating database");
+
+  dbh_do($dbh_template, "CREATE DATABASE \"" . $db_cfg->{db} . "\" TEMPLATE \"" . $db_cfg->{template} . "\" ENCODING 'UNICODE'", message => "Database could not be created");
+  $dbh_template->disconnect;
+
+  notice("Creating initial schema");
+
+  @dbi_options = (
+    'dbi:Pg:dbname=' . $db_cfg->{db} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
+    $db_cfg->{user},
+    $db_cfg->{password},
+    SL::DBConnect->get_options(PrintError => 0, PrintWarn => 0),
+  );
+
+  my $dbh           = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("Database connection failed: " . $DBI::errstr);
+  $::auth->{dbh} = $dbh;
+  my $dbupdater  = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, silent => 1);
+  my $coa        = 'Germany-DATEV-SKR03EU';
+
+  apply_dbupgrade($dbupdater, $dbh, "sql/lx-office.sql");
+  apply_dbupgrade($dbupdater, $dbh, "sql/${coa}-chart.sql");
+
+  dbh_do($dbh, qq|UPDATE defaults SET coa = '${coa}', accounting_method = 'cash', profit_determination = 'income', inventory_system = 'periodic', curr = 'EUR'|);
+  dbh_do($dbh, qq|CREATE TABLE schema_info (tag TEXT, login TEXT, itime TIMESTAMP DEFAULT now(), PRIMARY KEY (tag))|);
+
+  notice("Creating initial auth schema");
+
+  $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => 1);
+  apply_dbupgrade($dbupdater, $dbh, 'sql/auth_db.sql');
+
+  apply_upgrades(auth => 1, dbh => $dbh);
+
+  $::auth->reset;
+
+  notice("Creating client, user, group and employee");
+
+  dbh_do($dbh, qq|DELETE FROM auth.clients|);
+  dbh_do($dbh, qq|INSERT INTO auth.clients (id, name, dbhost, dbport, dbname, dbuser, dbpasswd, is_default) VALUES (1, 'Unit-Tests', ?, ?, ?, ?, ?, TRUE)|,
+         bind => [ @{ $db_cfg }{ qw(host port db user password) } ]);
+  dbh_do($dbh, qq|INSERT INTO auth."user"         (id,        login)    VALUES (1, 'unittests')|);
+  dbh_do($dbh, qq|INSERT INTO auth."group"        (id,        name)     VALUES (1, 'Vollzugriff')|);
+  dbh_do($dbh, qq|INSERT INTO auth.clients_users  (client_id, user_id)  VALUES (1, 1)|);
+  dbh_do($dbh, qq|INSERT INTO auth.clients_groups (client_id, group_id) VALUES (1, 1)|);
+  dbh_do($dbh, qq|INSERT INTO auth.user_group     (user_id,   group_id) VALUES (1, 1)|);
+
+  my %config                 = (
+    default_printer_id       => '',
+    template_format          => '',
+    default_media            => '',
+    email                    => 'unit@tester',
+    tel                      => '',
+    dateformat               => 'dd.mm.yy',
+    show_form_details        => '',
+    name                     => 'Unit Tester',
+    signature                => '',
+    hide_cvar_search_options => '',
+    numberformat             => '1.000,00',
+    favorites                => '',
+    copies                   => '',
+    menustyle                => 'v3',
+    fax                      => '',
+    stylesheet               => 'lx-office-erp.css',
+    mandatory_departments    => 0,
+    countrycode              => 'de',
+  );
+
+  my $sth = $dbh->prepare(qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (1, ?, ?)|) || BAIL_OUT($dbh->errstr);
+  dbh_do($dbh, $sth, bind => [ $_, $config{$_} ]) for sort keys %config;
+  $sth->finish;
+
+  $sth = $dbh->prepare(qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (1, ?, TRUE)|) || BAIL_OUT($dbh->errstr);
+  dbh_do($dbh, $sth, bind => [ $_ ]) for sort $::auth->all_rights;
+  $sth->finish;
+
+  dbh_do($dbh, qq|INSERT INTO employee (id, login, name) VALUES (1, 'unittests', 'Unit Tester')|);
+
+  $::auth->set_client(1) || BAIL_OUT("\$::auth->set_client(1) failed");
+  %::myconfig = $::auth->read_user(login => 'unittests');
+
+  apply_upgrades(dbh => $dbh);
+}
+
+sub apply_upgrades {
+  my %params            = @_;
+  my $dbupdater         = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => $params{auth});
+  my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($params{dbh});
+
+  my $all = @unapplied_scripts;
+  my $i;
+  for my $script (@unapplied_scripts) {
+    ++$i;
+    print "\rUpgrade $i/$all";
+    apply_dbupgrade($dbupdater, $params{dbh}, $script);
+  }
+  print " - done.\n";
+}
+
+sub apply_dbupgrade {
+  my ($dbupdater, $dbh, $control_or_file) = @_;
+
+  my $file    = ref($control_or_file) ? ("sql/Pg-upgrade2" . ($dbupdater->{auth} ? "-auth" : "") . "/$control_or_file->{file}") : $control_or_file;
+  my $control = ref($control_or_file) ? $control_or_file                                                                        : undef;
+
+  my $error = $dbupdater->process_file($dbh, $file, $control);
+
+  die("Error applying $file: $error") if $error;
+}
+
+sub dbh_do {
+  my ($dbh, $query, %params) = @_;
+
+  if (ref($query)) {
+    return if $query->execute(@{ $params{bind} || [] });
+    die($dbh->errstr);
+  }
+
+  return if $dbh->do($query, undef, @{ $params{bind} || [] });
+
+  die($params{message} . ": " . $dbh->errstr) if $params{message};
+  die("Query failed: " . $dbh->errstr . " ; query: $query");
+}
+
 parse_args(\%config);
 setup();
 parse_args(\%config);
 setup();
-my @tables = make_tables();
+check_errors_in_package_names();
 
 
-for my $table (@tables) {
-  # add default model name unless model name is given or no defaults exists
-  $table .= '=' . $package_names{LXOFFICE}->{lc $table} if $table !~ /=/ && $package_names{LXOFFICE}->{lc $table};
+my %tables_by_domain = make_tables();
 
 
-  process_table($table);
+foreach my $domain (keys %tables_by_domain) {
+  my @tables         = @{ $tables_by_domain{$domain} };
+  my @unknown_tables = grep { !$package_names{$domain}->{$_} } @tables;
+  if (@unknown_tables) {
+    error("The following tables do not have entries in \%SL::DB::Helper::Mappings::${domain}_package_names: " . join(' ', sort @unknown_tables));
+    exit 1;
+  }
+
+  process_table($domain, $_, $package_names{$domain}->{$_}) for @tables;
 }
 
 1;
 }
 
 1;
@@ -246,24 +580,28 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 
-rose_auto_create_model - mana Rose::DB::Object classes for Lx-Office
+rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
-  scripts/rose_create_model.pl --login login table1[=package1] [table2[=package2] ...]
-  scripts/rose_create_model.pl --login login [--all|-a]
+  scripts/rose_auto_create_model.pl OPTIONS TARGET
+
+  # use other client than devel.client
+  scripts/rose_auto_create_model.pl --test-client TARGET
+  scripts/rose_auto_create_model.pl --client name-or-id TARGET
 
 
+  # TARGETS:
   # updates all models
   # updates all models
-  scripts/rose_create_model.pl --login login --all
+  scripts/rose_auto_create_model.pl --all [--db db]
 
   # updates only customer table, login taken from config
 
   # updates only customer table, login taken from config
-  scripts/rose_create_model.pl customer
+  scripts/rose_auto_create_model.pl customer
 
   # updates only parts table, package will be Part
 
   # updates only parts table, package will be Part
-  scripts/rose_create_model.pl parts=Part
+  scripts/rose_auto_create_model.pl parts=Part
 
   # try to update parts, but don't do it. tell what would happen in detail
 
   # try to update parts, but don't do it. tell what would happen in detail
-  scripts/rose_create_model.pl --no-commit --verbose parts
+  scripts/rose_auto_create_model.pl --no-commit parts
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
@@ -300,27 +638,53 @@ In the most basic version, just give it a login and a table name, and it will
 load the schema information for this table and create the appropriate class
 files, or update them if already present.
 
 load the schema information for this table and create the appropriate class
 files, or update them if already present.
 
-Each table has two associated files. A C<SL::DB::MetaSetup::*> class, which is
-a perl version of the schema definition, and a C<SL::DB::*> class file. The
-first one will be updated if the schema changes, the second one will only be
-created if it does not exist.
+Each table has three associated files. A C<SL::DB::MetaSetup::*>
+class, which is a perl version of the schema definition, a
+C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
+file. The first one will be updated if the schema changes, the second
+and third ones will only be created if it they do not exist.
+
+=head1 DATABASE NAMES AND TABLES
+
+If you want to generate the data for specific tables only then you
+have to list them on the command line. The format is
+C<db-name:table-name>. The part C<db-name:> is optional and defaults
+to C<KIVITENDO:> – which means the tables in the default kivitendo
+database.
+
+Valid database names are keys in the hash returned by
+L<SL::DB::Helper::Mappings/get_package_names>.
 
 =head1 OPTIONS
 
 =over 4
 
 
 =head1 OPTIONS
 
 =over 4
 
-=item C<--login, -l LOGIN>
+=item C<--test-client, -t>
+
+Use the C<testing/database> to create a new testing database, and connect to
+the first client there. Overrides C<client>.
+
+If neither C<test-client> nor C<client> are set, the config key C<devel/client>
+will be used.
 
 
-=item C<--user, -u LOGIN>
+=item C<--client, -c CLIENT>
 
 
-Provide a login. If not present the login is loaded from the config key
-C<devel/login>. If that too is not found, an error is thrown.
+Provide a client whose database settings are used. C<CLIENT> can be either a
+database ID or a client's name.
+
+If neither C<test-client> nor C<client> are set, the config key C<devel/client>
+will be used.
 
 =item C<--all, -a>
 
 Process all tables from the database. Only those that are blacklistes in
 L<SL::DB::Helper::Mappings> are excluded.
 
 
 =item C<--all, -a>
 
 Process all tables from the database. Only those that are blacklistes in
 L<SL::DB::Helper::Mappings> are excluded.
 
+=item C<--db db>
+
+In combination with C<--all> causes all tables in the specific
+database to be processed, not in all databases.
+
 =item C<--no-commit, -n>
 
 =item C<--dry-run>
 =item C<--no-commit, -n>
 
 =item C<--dry-run>
@@ -337,10 +701,10 @@ different. Beware, does not imply C<--no-commit>.
 
 Print this help.
 
 
 Print this help.
 
-=item C<--verbose, -v>
+=item C<--quiet, -q>
 
 
-Prints extra information, such as skipped files that were not changed and
-errors where the auto initialization failed.
+Does not print extra information, such as skipped files that were not
+changed and errors where the auto initialization failed.
 
 =back
 
 
 =back
 
@@ -350,6 +714,7 @@ None yet.
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 
 =cut
 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 
 =cut