scripts/rose_auto_create_model.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 BEGIN {
   6   unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
   7   push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
   8 }
   9
  10 use CGI qw( -no_xhtml);
  11 use Config::Std;
  12 use Data::Dumper;
  13 use Digest::MD5 qw(md5_hex);
  14 use English qw( -no_match_vars );
  15 use Getopt::Long;
  16 use List::MoreUtils qw(none);
  17 use List::UtilsBy qw(partition_by);
  18 use Pod::Usage;
  19 use Rose::DB::Object 0.809;
  20 use Term::ANSIColor;
  21
  22 use SL::Auth;
  23 use SL::DBUtils;
  24 use SL::DB;
  25 use SL::Form;
  26 use SL::InstanceConfiguration;
  27 use SL::Locale;
  28 use SL::LXDebug;
  29 use SL::LxOfficeConf;
  30 use SL::DB::Helper::ALL;
  31 use SL::DB::Helper::Mappings;
  32
  33 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
  34 my %package_names = SL::DB::Helper::Mappings->get_package_names;
  35
  36 our $form;
  37 our $auth;
  38 our %lx_office_conf;
  39
  40 our $script =  __FILE__;
  41 $script     =~ s{.*/}{};
  42
  43 $OUTPUT_AUTOFLUSH       = 1;
  44 $Data::Dumper::Sortkeys = 1;
  45
  46 our $meta_path    = "SL/DB/MetaSetup";
  47 our $manager_path = "SL/DB/Manager";
  48
  49 my %config;
  50
  51 # Maps column names in tables to foreign key relationship names.  For
  52 # example:
  53 #
  54 # »follow_up_access« contains a column named »who«. Rose normally
  55 # names the resulting relationship after the class the target table
  56 # uses. In this case the target table is »employee« and the
  57 # corresponding class SL::DB::Employee. The resulting relationship
  58 # would be named »employee«.
  59 #
  60 # In order to rename this relationship we have to map »who« to
  61 # e.g. »granted_by«:
  62 #   follow_up_access => { who => 'granted_by' },
  63
  64 our %foreign_key_name_map     = (
  65   KIVITENDO                   => {
  66     oe                        => { payment_id => 'payment_terms', },
  67     ar                        => { payment_id => 'payment_terms', },
  68     ap                        => { payment_id => 'payment_terms', },
  69
  70     orderitems                => { parts_id => 'part', trans_id => 'order', },
  71     delivery_order_items      => { parts_id => 'part' },
  72     invoice                   => { parts_id => 'part' },
  73     follow_ups                => { created_for_user => 'created_for', created_by => 'created_by', },
  74     follow_up_access          => { who => 'with_access', what => 'to_follow_ups_by', },
  75
  76     periodic_invoices_configs => { oe_id => 'order' },
  77     reconciliation_links      => { acc_trans_id => 'acc_trans' },
  78   },
  79 );
  80
  81 sub setup {
  82
  83   SL::LxOfficeConf->read;
  84
  85   my $client     = $config{client} || $::lx_office_conf{devel}{client};
  86   my $new_client = $config{new_client};
  87
  88   if (!$client && !$new_client) {
  89     error("No client found in config. Please provide a client:");
  90     usage();
  91   }
  92
  93   $::lxdebug       = LXDebug->new();
  94   $::lxdebug->disable_sub_tracing;
  95   $::locale        = Locale->new("de");
  96   $::form          = new Form;
  97   $::instance_conf = SL::InstanceConfiguration->new;
  98   $form->{script}  = 'rose_meta_data.pl';
  99
 100   if ($new_client) {
 101     $::auth       = SL::Auth->new(unit_tests_database => 1);
 102     $client       = 1;
 103     drop_and_create_test_database();
 104   } else {
 105     $::auth       = SL::Auth->new();
 106   }
 107
 108   if (!$::auth->set_client($client)) {
 109     error("No client with ID or name '$client' found in config. Please provide a client:");
 110     usage();
 111   }
 112
 113   foreach (($meta_path, $manager_path)) {
 114     mkdir $_ unless -d;
 115   }
 116 }
 117
 118 sub fix_relationship_names {
 119   my ($domain, $table, $fkey_text) = @_;
 120
 121   if ($fkey_text !~ m/key_columns \s+ => \s+ \{ \s+ ['"]? ( [^'"\s]+ ) /x) {
 122     die "fix_relationship_names: could not extract the key column for domain/table $domain/$table; foreign key definition text:\n${fkey_text}\n";
 123   }
 124
 125   my $column_name = $1;
 126   my %changes     = map { %{$_} } grep { $_ } ($foreign_key_name_map{$domain}->{ALL}, $foreign_key_name_map{$domain}->{$table});
 127
 128   if (my $desired_name = $changes{$column_name}) {
 129     $fkey_text =~ s/^ \s\s [^\s]+ \b/  ${desired_name}/msx;
 130   }
 131
 132   return $fkey_text;
 133 }
 134
 135 sub process_table {
 136   my ($domain, $table, $package) = @_;
 137   my $schema     = '';
 138   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
 139   $package       =  ucfirst($package || $table);
 140   $package       =~ s/_+(.)/uc($1)/ge;
 141   my $meta_file  =  "${meta_path}/${package}.pm";
 142   my $mngr_file  =  "${manager_path}/${package}.pm";
 143   my $file       =  "SL/DB/${package}.pm";
 144
 145   my $schema_str = $schema ? <<CODE : '';
 146 __PACKAGE__->meta->schema('$schema');
 147 CODE
 148
 149   eval <<CODE;
 150     package SL::DB::AUTO::$package;
 151     use SL::DB::Object;
 152     use base qw(SL::DB::Object);
 153
 154     __PACKAGE__->meta->table('$table');
 155     $schema_str
 156     __PACKAGE__->meta->auto_initialize;
 157
 158 CODE
 159
 160   if ($EVAL_ERROR) {
 161     error("Error in execution for table '$table'");
 162     error("'$EVAL_ERROR'") unless $config{quiet};
 163     return;
 164   }
 165
 166   my %args = (indent => 2, use_setup => 0);
 167
 168   my $definition =  "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
 169   $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;
 170   $definition =~ s/::AUTO::/::/g;
 171
 172
 173   # Sort column definitions alphabetically
 174   if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
 175     my ($start, $end)  = ($-[1], $+[1]);
 176     my $sorted_columns = join "\n", sort split m/\n/, $1;
 177     substr $definition, $start, $end - $start, $sorted_columns;
 178   }
 179
 180   # patch foreign keys
 181   my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
 182   $foreign_key_definition =~ s/::AUTO::/::/g;
 183
 184   if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
 185     # These positions refer to the whole setup call, not just the
 186     # parameters/actual relationship definitions.
 187     my ($start, $end) = ($-[0], $+[0]);
 188
 189     # Match the function parameters = the actual relationship
 190     # definitions
 191     next unless $foreign_key_definition =~ m/\(\n(.+)\n\)/s;
 192
 193     my ($list_start, $list_end) = ($-[0], $+[0]);
 194
 195     # Split the whole chunk on double new lines. The resulting
 196     # elements are one relationship each. Then fix the relationship
 197     # names and sort them by their new names.
 198     my @new_foreign_keys = sort map { fix_relationship_names($domain, $table, $_) } split m/\n\n/m, $1;
 199
 200     # Replace the function parameters = the actual relationship
 201     # definitions with the new ones.
 202     my $sorted_foreign_keys = "(\n" . join("\n\n", @new_foreign_keys) . "\n)";
 203     substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;
 204
 205     # Replace the whole setup call in the auto-generated output with
 206     # our new version.
 207     substr $definition, $start, $end - $start, $foreign_key_definition;
 208   }
 209
 210   $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
 211
 212   my $full_definition = <<CODE;
 213 # This file has been auto-generated. Do not modify it; it will be overwritten
 214 # by $::script automatically.
 215 $definition;
 216 CODE
 217
 218   my $meta_definition = <<CODE;
 219 # This file has been auto-generated only because it didn't exist.
 220 # Feel free to modify it at will; it will not be overwritten automatically.
 221
 222 package SL::DB::${package};
 223
 224 use strict;
 225
 226 use SL::DB::MetaSetup::${package};
 227 use SL::DB::Manager::${package};
 228
 229 __PACKAGE__->meta->initialize;
 230
 231 1;
 232 CODE
 233
 234   my $file_exists = -f $meta_file;
 235   if ($file_exists) {
 236     my $old_size    = -s $meta_file;
 237     my $orig_file   = do { local(@ARGV, $/) = ($meta_file); <> };
 238     my $old_md5     = md5_hex($orig_file);
 239     my $new_size    = length $full_definition;
 240     my $new_md5     = md5_hex($full_definition);
 241     if ($old_size == $new_size && $old_md5 eq $new_md5) {
 242       notice("No changes in $meta_file, skipping.") unless $config{quiet};
 243       return;
 244     }
 245
 246     show_diff(\$orig_file, \$full_definition) if $config{show_diff};
 247   }
 248
 249   if (!$config{nocommit}) {
 250     open my $out, ">", $meta_file || die;
 251     print $out $full_definition;
 252   }
 253
 254   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 255
 256   return if -f $file;
 257
 258   if (!$config{nocommit}) {
 259     open my $out, ">", $file || die;
 260     print $out $meta_definition;
 261   }
 262
 263   notice("File '$file' created as well.");
 264
 265   return if -f $mngr_file;
 266
 267   if (!$config{nocommit}) {
 268     open my $out, ">", $mngr_file || die;
 269     print $out <<EOT;
 270 # This file has been auto-generated only because it didn't exist.
 271 # Feel free to modify it at will; it will not be overwritten automatically.
 272
 273 package SL::DB::Manager::${package};
 274
 275 use strict;
 276
 277 use SL::DB::Helper::Manager;
 278 use base qw(SL::DB::Helper::Manager);
 279
 280 sub object_class { 'SL::DB::${package}' }
 281
 282 __PACKAGE__->make_manager_methods;
 283
 284 1;
 285 EOT
 286   }
 287
 288   notice("File '$mngr_file' created as well.");
 289 }
 290
 291 sub parse_args {
 292   my ($options) = @_;
 293   GetOptions(
 294     'client=s'          => \ my $client,
 295     'test-client'       => \ my $use_test_client,
 296     all                 => \ my $all,
 297     'db=s'              => \ my $db,
 298     'no-commit|dry-run' => \ my $nocommit,
 299     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
 300     quiet               => \ my $quiet,
 301     diff                => \ my $diff,
 302   );
 303
 304   $options->{client}     = $client;
 305   $options->{new_client} = $use_test_client;
 306   $options->{all}        = $all;
 307   $options->{db}         = $db;
 308   $options->{nocommit}   = $nocommit;
 309   $options->{quiet}      = $quiet;
 310   $options->{color}      = -t STDOUT ? 1 : 0;
 311
 312   if ($diff) {
 313     if (eval { require Text::Diff; 1 }) {
 314       $options->{show_diff} = 1;
 315     } else {
 316       error('Could not load Text::Diff. Sorry, no diffs for you.');
 317     }
 318   }
 319 }
 320
 321 sub show_diff {
 322    my ($text_a, $text_b) = @_;
 323
 324    my %colors = (
 325      '+' => 'green',
 326      '-' => 'red',
 327    );
 328
 329    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
 330      for (split /\n/, $_[0]) {
 331        if ($config{color}) {
 332          print colored($_, $colors{substr($_, 0, 1)}), $/;
 333        } else {
 334          print $_, $/;
 335        }
 336      }
 337    }});
 338 }
 339
 340 sub usage {
 341   pod2usage(verbose => 99, sections => 'SYNOPSIS');
 342 }
 343
 344 sub make_tables {
 345   my %tables_by_domain;
 346   if ($config{all}) {
 347     my @domains = $config{db} ? (uc $config{db}) : sort keys %package_names;
 348
 349     foreach my $domain (@domains) {
 350       my $db  = SL::DB::create(undef, $domain);
 351       $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } $db->list_tables ];
 352       $db->disconnect;
 353     }
 354
 355   } elsif (@ARGV) {
 356     %tables_by_domain = partition_by {
 357       my ($domain, $table) = split m{:};
 358       $table ? uc($domain) : 'KIVITENDO';
 359     } @ARGV;
 360
 361     foreach my $tables (values %tables_by_domain) {
 362       s{.*:}{} for @{ $tables };
 363     }
 364
 365   } else {
 366     error("You specified neither --all nor any specific tables.");
 367     usage();
 368   }
 369
 370   return %tables_by_domain;
 371 }
 372
 373 sub error {
 374   print STDERR colored(shift, 'red'), $/;
 375 }
 376
 377 sub notice {
 378   print @_, $/;
 379 }
 380
 381 sub check_errors_in_package_names {
 382   foreach my $domain (sort keys %package_names) {
 383     my @both = grep { $package_names{$domain}->{$_} } @{ $blacklist{$domain} || [] };
 384     next unless @both;
 385
 386     print "Error: domain '$domain': The following table names are present in both the black list and the package name hash: ", join(' ', sort @both), "\n";
 387     exit 1;
 388   }
 389 }
 390
 391 sub drop_and_create_test_database {
 392   my $db_cfg          = $::lx_office_conf{'testing/database'} || die 'testing/database missing';
 393
 394   my @dbi_options = (
 395     'dbi:Pg:dbname=' . $db_cfg->{template} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
 396     $db_cfg->{user},
 397     $db_cfg->{password},
 398     SL::DBConnect->get_options,
 399   );
 400
 401   $::auth->reset;
 402   my $dbh_template = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("No database connection to the template database: " . $DBI::errstr);
 403   my $auth_dbh     = $::auth->dbconnect(1);
 404
 405   if ($auth_dbh) {
 406     notice("Database exists; dropping");
 407     $auth_dbh->disconnect;
 408
 409     dbh_do($dbh_template, "DROP DATABASE \"" . $db_cfg->{db} . "\"", message => "Database could not be dropped");
 410
 411     $::auth->reset;
 412   }
 413
 414   notice("Creating database");
 415
 416   dbh_do($dbh_template, "CREATE DATABASE \"" . $db_cfg->{db} . "\" TEMPLATE \"" . $db_cfg->{template} . "\" ENCODING 'UNICODE'", message => "Database could not be created");
 417   $dbh_template->disconnect;
 418
 419   notice("Creating initial schema");
 420
 421   @dbi_options = (
 422     'dbi:Pg:dbname=' . $db_cfg->{db} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
 423     $db_cfg->{user},
 424     $db_cfg->{password},
 425     SL::DBConnect->get_options(PrintError => 0, PrintWarn => 0),
 426   );
 427
 428   my $dbh           = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("Database connection failed: " . $DBI::errstr);
 429   $::auth->{dbh} = $dbh;
 430   my $dbupdater  = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, silent => 1);
 431   my $coa        = 'Germany-DATEV-SKR03EU';
 432
 433   apply_dbupgrade($dbupdater, $dbh, "sql/lx-office.sql");
 434   apply_dbupgrade($dbupdater, $dbh, "sql/${coa}-chart.sql");
 435
 436   dbh_do($dbh, qq|UPDATE defaults SET coa = '${coa}', accounting_method = 'cash', profit_determination = 'income', inventory_system = 'periodic', curr = 'EUR'|);
 437   dbh_do($dbh, qq|CREATE TABLE schema_info (tag TEXT, login TEXT, itime TIMESTAMP DEFAULT now(), PRIMARY KEY (tag))|);
 438
 439   notice("Creating initial auth schema");
 440
 441   $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => 1);
 442   apply_dbupgrade($dbupdater, $dbh, 'sql/auth_db.sql');
 443
 444   apply_upgrades(auth => 1, dbh => $dbh);
 445
 446   notice("Creating client, user, group and employee");
 447
 448   dbh_do($dbh, qq|DELETE FROM auth.clients|);
 449   dbh_do($dbh, qq|INSERT INTO auth.clients (id, name, dbhost, dbport, dbname, dbuser, dbpasswd, is_default) VALUES (1, 'Unit-Tests', ?, ?, ?, ?, ?, TRUE)|,
 450          bind => [ @{ $db_cfg }{ qw(host port db user password) } ]);
 451   dbh_do($dbh, qq|INSERT INTO auth."user"         (id,        login)    VALUES (1, 'unittests')|);
 452   dbh_do($dbh, qq|INSERT INTO auth."group"        (id,        name)     VALUES (1, 'Vollzugriff')|);
 453   dbh_do($dbh, qq|INSERT INTO auth.clients_users  (client_id, user_id)  VALUES (1, 1)|);
 454   dbh_do($dbh, qq|INSERT INTO auth.clients_groups (client_id, group_id) VALUES (1, 1)|);
 455   dbh_do($dbh, qq|INSERT INTO auth.user_group     (user_id,   group_id) VALUES (1, 1)|);
 456
 457   my %config                 = (
 458     default_printer_id       => '',
 459     template_format          => '',
 460     default_media            => '',
 461     email                    => 'unit@tester',
 462     tel                      => '',
 463     dateformat               => 'dd.mm.yy',
 464     show_form_details        => '',
 465     name                     => 'Unit Tester',
 466     signature                => '',
 467     hide_cvar_search_options => '',
 468     numberformat             => '1.000,00',
 469     vclimit                  => 0,
 470     favorites                => '',
 471     copies                   => '',
 472     menustyle                => 'v3',
 473     fax                      => '',
 474     stylesheet               => 'lx-office-erp.css',
 475     mandatory_departments    => 0,
 476     countrycode              => 'de',
 477   );
 478
 479   my $sth = $dbh->prepare(qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (1, ?, ?)|) || BAIL_OUT($dbh->errstr);
 480   dbh_do($dbh, $sth, bind => [ $_, $config{$_} ]) for sort keys %config;
 481   $sth->finish;
 482
 483   $sth = $dbh->prepare(qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (1, ?, TRUE)|) || BAIL_OUT($dbh->errstr);
 484   dbh_do($dbh, $sth, bind => [ $_ ]) for sort $::auth->all_rights;
 485   $sth->finish;
 486
 487   dbh_do($dbh, qq|INSERT INTO employee (id, login, name) VALUES (1, 'unittests', 'Unit Tester')|);
 488
 489   $::auth->set_client(1) || BAIL_OUT("\$::auth->set_client(1) failed");
 490   %::myconfig = $::auth->read_user(login => 'unittests');
 491
 492   apply_upgrades(dbh => $dbh);
 493 }
 494
 495 sub apply_upgrades {
 496   my %params            = @_;
 497   my $dbupdater         = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => $params{auth});
 498   my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($params{dbh});
 499
 500   my $all = @unapplied_scripts;
 501   my $i;
 502   for my $script (@unapplied_scripts) {
 503     ++$i;
 504     print "\rUpgrade $i/$all";
 505     apply_dbupgrade($dbupdater, $params{dbh}, $script);
 506   }
 507   print " - done.\n";
 508 }
 509
 510 sub apply_dbupgrade {
 511   my ($dbupdater, $dbh, $control_or_file) = @_;
 512
 513   my $file    = ref($control_or_file) ? ("sql/Pg-upgrade2" . ($dbupdater->{auth} ? "-auth" : "") . "/$control_or_file->{file}") : $control_or_file;
 514   my $control = ref($control_or_file) ? $control_or_file                                                                        : undef;
 515
 516   my $error = $dbupdater->process_file($dbh, $file, $control);
 517
 518   die("Error applying $file: $error") if $error;
 519 }
 520
 521 sub dbh_do {
 522   my ($dbh, $query, %params) = @_;
 523
 524   if (ref($query)) {
 525     return if $query->execute(@{ $params{bind} || [] });
 526     die($dbh->errstr);
 527   }
 528
 529   return if $dbh->do($query, undef, @{ $params{bind} || [] });
 530
 531   die($params{message} . ": " . $dbh->errstr) if $params{message};
 532   die("Query failed: " . $dbh->errstr . " ; query: $query");
 533 }
 534
 535 parse_args(\%config);
 536 setup();
 537 check_errors_in_package_names();
 538
 539 my %tables_by_domain = make_tables();
 540
 541 foreach my $domain (keys %tables_by_domain) {
 542   my @tables         = @{ $tables_by_domain{$domain} };
 543   my @unknown_tables = grep { !$package_names{$domain}->{$_} } @tables;
 544   if (@unknown_tables) {
 545     error("The following tables do not have entries in \%SL::DB::Helper::Mappings::${domain}_package_names: " . join(' ', sort @unknown_tables));
 546     exit 1;
 547   }
 548
 549   process_table($domain, $_, $package_names{$domain}->{$_}) for @tables;
 550 }
 551
 552 1;
 553
 554 __END__
 555
 556 =encoding utf-8
 557
 558 =head1 NAME
 559
 560 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
 561
 562 =head1 SYNOPSIS
 563
 564   scripts/rose_auto_create_model.pl OPTIONS TARGET
 565
 566   # use other client than devel.client
 567   scripts/rose_auto_create_model.pl --test-client TARGET
 568   scripts/rose_auto_create_model.pl --client name-or-id TARGET
 569
 570   # TARGETS:
 571   # updates all models
 572   scripts/rose_auto_create_model.pl --all [--db db]
 573
 574   # updates only customer table, login taken from config
 575   scripts/rose_auto_create_model.pl customer
 576
 577   # updates only parts table, package will be Part
 578   scripts/rose_auto_create_model.pl parts=Part
 579
 580   # try to update parts, but don't do it. tell what would happen in detail
 581   scripts/rose_auto_create_model.pl --no-commit parts
 582
 583 =head1 DESCRIPTION
 584
 585 Rose::DB::Object comes with a nice function named auto initialization with code
 586 generation. The documentation of Rose describes it like this:
 587
 588 I<[...] auto-initializing metadata at runtime by querying the database has many
 589 caveats. An alternate approach is to query the database for metadata just once,
 590 and then generate the equivalent Perl code which can be pasted directly into
 591 the class definition in place of the call to auto_initialize.>
 592
 593 I<Like the auto-initialization process itself, perl code generation has a
 594 convenient wrapper method as well as separate methods for the individual parts.
 595 All of the perl code generation methods begin with "perl_", and they support
 596 some rudimentary code formatting options to help the code conform to you
 597 preferred style. Examples can be found with the documentation for each perl_*
 598 method.>
 599
 600 I<This hybrid approach to metadata population strikes a good balance between
 601 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
 602 initial class definition saves a lot of tedious typing. From that point on,
 603 manually correcting and maintaining the definition is a small price to pay for
 604 the decreased start-up cost, the ability to use the class in the absence of a
 605 database connection, and the piece of mind that comes from knowing that your
 606 class is stable, and won't change behind your back in response to an "action at
 607 a distance" (i.e., a database schema update).>
 608
 609 Unfortunately this reads easier than it is, since classes need to go into the
 610 right package and directory, certain stuff needs to be adjusted and table names
 611 need to be translated into their class names. This script will wrap all that
 612 behind a few simple options.
 613
 614 In the most basic version, just give it a login and a table name, and it will
 615 load the schema information for this table and create the appropriate class
 616 files, or update them if already present.
 617
 618 Each table has three associated files. A C<SL::DB::MetaSetup::*>
 619 class, which is a perl version of the schema definition, a
 620 C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
 621 file. The first one will be updated if the schema changes, the second
 622 and third ones will only be created if it they do not exist.
 623
 624 =head1 DATABASE NAMES AND TABLES
 625
 626 If you want to generate the data for specific tables only then you
 627 have to list them on the command line. The format is
 628 C<db-name:table-name>. The part C<db-name:> is optional and defaults
 629 to C<KIVITENDO:> – which means the tables in the default kivitendo
 630 database.
 631
 632 Valid database names are keys in the hash returned by
 633 L<SL::DB::Helper::Mappings/get_package_names>.
 634
 635 =head1 OPTIONS
 636
 637 =over 4
 638
 639 =item C<--test-client, -t>
 640
 641 Use the C<testing/database> to create a new testing database, and connect to
 642 the first client there. Overrides C<client>.
 643
 644 If neither C<test-client> nor C<client> are set, the config key C<devel/client>
 645 will be used.
 646
 647 =item C<--client, -c CLIENT>
 648
 649 Provide a client whose database settings are used. C<CLIENT> can be either a
 650 database ID or a client's name.
 651
 652 If neither C<test-client> nor C<client> are set, the config key C<devel/client>
 653 will be used.
 654
 655 =item C<--all, -a>
 656
 657 Process all tables from the database. Only those that are blacklistes in
 658 L<SL::DB::Helper::Mappings> are excluded.
 659
 660 =item C<--db db>
 661
 662 In combination with C<--all> causes all tables in the specific
 663 database to be processed, not in all databases.
 664
 665 =item C<--no-commit, -n>
 666
 667 =item C<--dry-run>
 668
 669 Do not write back generated files. This will do everything as usual but not
 670 actually modify any file.
 671
 672 =item C<--diff>
 673
 674 Displays diff for selected file, if file is present and newer file is
 675 different. Beware, does not imply C<--no-commit>.
 676
 677 =item C<--help, -h>
 678
 679 Print this help.
 680
 681 =item C<--quiet, -q>
 682
 683 Does not print extra information, such as skipped files that were not
 684 changed and errors where the auto initialization failed.
 685
 686 =back
 687
 688 =head1 BUGS
 689
 690 None yet.
 691
 692 =head1 AUTHOR
 693
 694 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 695 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 696
 697 =cut