scripts/rose_auto_create_model.pl

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