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   push   (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version.
  11 }
  12
  13 use CGI qw( -no_xhtml);
  14 use Config::Std;
  15 use Data::Dumper;
  16 use Digest::MD5 qw(md5_hex);
  17 use English qw( -no_match_vars );
  18 use Getopt::Long;
  19 use List::MoreUtils qw(apply none uniq);
  20 use List::UtilsBy qw(partition_by);
  21 use Pod::Usage;
  22 use Rose::DB::Object 0.809;
  23 use Term::ANSIColor;
  24
  25 use SL::Auth;
  26 use SL::DBUtils;
  27 use SL::DB;
  28 use SL::Form;
  29 use SL::InstanceConfiguration;
  30 use SL::Locale;
  31 use SL::LXDebug;
  32 use SL::LxOfficeConf;
  33 use SL::DB::Helper::ALL;
  34 use SL::DB::Helper::Mappings;
  35
  36 chdir($FindBin::Bin . '/..');
  37
  38 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
  39 my %package_names = SL::DB::Helper::Mappings->get_package_names;
  40
  41 our $form;
  42 our $auth;
  43 our %lx_office_conf;
  44
  45 our $script =  __FILE__;
  46 $script     =~ s{.*/}{};
  47
  48 $OUTPUT_AUTOFLUSH       = 1;
  49 $Data::Dumper::Sortkeys = 1;
  50
  51 our $meta_path    = "SL/DB/MetaSetup";
  52 our $manager_path = "SL/DB/Manager";
  53
  54 my %config;
  55
  56 # Maps column names in tables to foreign key relationship names.  For
  57 # example:
  58 #
  59 # »follow_up_access« contains a column named »who«. Rose normally
  60 # names the resulting relationship after the class the target table
  61 # uses. In this case the target table is »employee« and the
  62 # corresponding class SL::DB::Employee. The resulting relationship
  63 # would be named »employee«.
  64 #
  65 # In order to rename this relationship we have to map »who« to
  66 # e.g. »granted_by«:
  67 #   follow_up_access => { who => 'granted_by' },
  68
  69 our %foreign_key_name_map     = (
  70   KIVITENDO                   => {
  71     oe                        => { payment_id => 'payment_terms', },
  72     ar                        => { payment_id => 'payment_terms', },
  73     ap                        => { payment_id => 'payment_terms', },
  74
  75     orderitems                => { parts_id => 'part', trans_id => 'order', },
  76     delivery_order_items      => { parts_id => 'part' },
  77     invoice                   => { parts_id => 'part' },
  78     follow_ups                => { created_for_user => 'created_for_employee', created_by => 'created_by_employee', },
  79     follow_up_access          => { who => 'with_access', what => 'to_follow_ups_by', },
  80
  81     periodic_invoices_configs => { oe_id => 'order', email_recipient_contact_id => 'email_recipient_contact' },
  82     reconciliation_links      => { acc_trans_id => 'acc_trans' },
  83
  84     assembly                  => { parts_id => 'part', id => 'assembly_part' },
  85     assortment_items          => { parts_id => 'part' },
  86   },
  87 );
  88
  89 sub setup {
  90
  91   SL::LxOfficeConf->read;
  92
  93   my $client     = $config{client} || $::lx_office_conf{devel}{client};
  94   my $new_client = $config{new_client};
  95
  96   if (!$client && !$new_client) {
  97     error("No client found in config. Please provide a client:");
  98     usage();
  99   }
 100
 101   $::lxdebug       = LXDebug->new();
 102   $::lxdebug->disable_sub_tracing;
 103   $::locale        = Locale->new("de");
 104   $::form          = new Form;
 105   $::instance_conf = SL::InstanceConfiguration->new;
 106   $form->{script}  = 'rose_meta_data.pl';
 107
 108   if ($new_client) {
 109     $::auth       = SL::Auth->new(unit_tests_database => 1);
 110     $client       = 1;
 111     drop_and_create_test_database();
 112   } else {
 113     $::auth       = SL::Auth->new();
 114   }
 115
 116   if (!$::auth->set_client($client)) {
 117     error("No client with ID or name '$client' found in config. Please provide a client:");
 118     usage();
 119   }
 120
 121   foreach (($meta_path, $manager_path)) {
 122     mkdir $_ unless -d;
 123   }
 124 }
 125
 126 sub fix_relationship_names {
 127   my ($domain, $table, $fkey_text) = @_;
 128
 129   if ($fkey_text !~ m/key_columns \s+ => \s+ \{ \s+ ['"]? ( [^'"\s]+ ) /x) {
 130     die "fix_relationship_names: could not extract the key column for domain/table $domain/$table; foreign key definition text:\n${fkey_text}\n";
 131   }
 132
 133   my $column_name = $1;
 134   my %changes     = map { %{$_} } grep { $_ } ($foreign_key_name_map{$domain}->{ALL}, $foreign_key_name_map{$domain}->{$table});
 135
 136   if (my $desired_name = $changes{$column_name}) {
 137     $fkey_text =~ s/^ \s\s [^\s]+ \b/  ${desired_name}/msx;
 138   }
 139
 140   return $fkey_text;
 141 }
 142
 143 sub process_table {
 144   my ($domain, $table, $package) = @_;
 145   my $schema     = '';
 146   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
 147   $package       =  ucfirst($package || $table);
 148   $package       =~ s/_+(.)/uc($1)/ge;
 149   my $meta_file  =  "${meta_path}/${package}.pm";
 150   my $mngr_file  =  "${manager_path}/${package}.pm";
 151   my $file       =  "SL/DB/${package}.pm";
 152
 153   my $schema_str = $schema ? <<CODE : '';
 154 __PACKAGE__->meta->schema('$schema');
 155 CODE
 156
 157   eval <<CODE;
 158     package SL::DB::AUTO::$package;
 159     use parent qw(SL::DB::Object);
 160
 161     __PACKAGE__->meta->table('$table');
 162     $schema_str
 163     __PACKAGE__->meta->auto_initialize;
 164
 165 CODE
 166
 167   if ($EVAL_ERROR) {
 168     error("Error in execution for table '$table'");
 169     error("'$EVAL_ERROR'") unless $config{quiet};
 170     return;
 171   }
 172
 173   my %args = (indent => 2, use_setup => 0);
 174
 175   my $definition =  "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
 176   $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;
 177   $definition =~ s/::AUTO::/::/g;
 178
 179
 180   # Sort column definitions alphabetically
 181   if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
 182     my ($start, $end)  = ($-[1], $+[1]);
 183     my $sorted_columns = join "\n", sort split m/\n/, $1;
 184     substr $definition, $start, $end - $start, $sorted_columns;
 185   }
 186
 187   # patch foreign keys
 188   my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
 189   $foreign_key_definition =~ s/::AUTO::/::/g;
 190
 191   if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
 192     # These positions refer to the whole setup call, not just the
 193     # parameters/actual relationship definitions.
 194     my ($start, $end) = ($-[0], $+[0]);
 195
 196     # Match the function parameters = the actual relationship
 197     # definitions
 198     next unless $foreign_key_definition =~ m/\(\n(.+)\n\)/s;
 199
 200     my ($list_start, $list_end) = ($-[0], $+[0]);
 201
 202     # Split the whole chunk on double new lines. The resulting
 203     # elements are one relationship each. Then fix the relationship
 204     # names and sort them by their new names.
 205     my @new_foreign_keys = sort map { fix_relationship_names($domain, $table, $_) } split m/\n\n/m, $1;
 206
 207     # Replace the function parameters = the actual relationship
 208     # definitions with the new ones.
 209     my $sorted_foreign_keys = "(\n" . join("\n\n", @new_foreign_keys) . "\n)";
 210     substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;
 211
 212     # Replace the whole setup call in the auto-generated output with
 213     # our new version.
 214     substr $definition, $start, $end - $start, $foreign_key_definition;
 215   }
 216
 217   $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
 218   $definition =~ s{^use base}{use parent}m;
 219
 220   my $full_definition = <<CODE;
 221 # This file has been auto-generated. Do not modify it; it will be overwritten
 222 # by $::script automatically.
 223 $definition;
 224 CODE
 225
 226   my $meta_definition = <<CODE;
 227 # This file has been auto-generated only because it didn't exist.
 228 # Feel free to modify it at will; it will not be overwritten automatically.
 229
 230 package SL::DB::${package};
 231
 232 use strict;
 233
 234 use SL::DB::MetaSetup::${package};
 235 use SL::DB::Manager::${package};
 236
 237 __PACKAGE__->meta->initialize;
 238
 239 1;
 240 CODE
 241
 242   my $file_exists = -f $meta_file;
 243   if ($file_exists) {
 244     my $old_size    = -s $meta_file;
 245     my $orig_file   = do { local(@ARGV, $/) = ($meta_file); <> };
 246     my $old_md5     = md5_hex($orig_file);
 247     my $new_size    = length $full_definition;
 248     my $new_md5     = md5_hex($full_definition);
 249     if ($old_size == $new_size && $old_md5 eq $new_md5) {
 250       notice("No changes in $meta_file, skipping.") unless $config{quiet};
 251       return;
 252     }
 253
 254     show_diff(\$orig_file, \$full_definition) if $config{show_diff};
 255   }
 256
 257   if (!$config{nocommit}) {
 258     open my $out, ">", $meta_file || die;
 259     print $out $full_definition;
 260   }
 261
 262   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 263
 264   return if -f $file;
 265
 266   if (!$config{nocommit}) {
 267     open my $out, ">", $file || die;
 268     print $out $meta_definition;
 269   }
 270
 271   notice("File '$file' created as well.");
 272
 273   return if -f $mngr_file;
 274
 275   if (!$config{nocommit}) {
 276     open my $out, ">", $mngr_file || die;
 277     print $out <<EOT;
 278 # This file has been auto-generated only because it didn't exist.
 279 # Feel free to modify it at will; it will not be overwritten automatically.
 280
 281 package SL::DB::Manager::${package};
 282
 283 use strict;
 284
 285 use parent qw(SL::DB::Helper::Manager);
 286
 287 sub object_class { 'SL::DB::${package}' }
 288
 289 __PACKAGE__->make_manager_methods;
 290
 291 1;
 292 EOT
 293   }
 294
 295   notice("File '$mngr_file' created as well.");
 296 }
 297
 298 sub parse_args {
 299   my ($options) = @_;
 300   GetOptions(
 301     'client=s'          => \ my $client,
 302     'test-client'       => \ my $use_test_client,
 303     all                 => \ my $all,
 304     'db=s'              => \ my $db,
 305     'no-commit|dry-run' => \ my $nocommit,
 306     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
 307     quiet               => \ my $quiet,
 308     diff                => \ my $diff,
 309   );
 310
 311   $options->{client}     = $client;
 312   $options->{new_client} = $use_test_client;
 313   $options->{all}        = $all;
 314   $options->{db}         = $db;
 315   $options->{nocommit}   = $nocommit;
 316   $options->{quiet}      = $quiet;
 317   $options->{color}      = -t STDOUT ? 1 : 0;
 318
 319   if ($diff) {
 320     if (eval { require Text::Diff; 1 }) {
 321       $options->{show_diff} = 1;
 322     } else {
 323       error('Could not load Text::Diff. Sorry, no diffs for you.');
 324     }
 325   }
 326 }
 327
 328 sub show_diff {
 329    my ($text_a, $text_b) = @_;
 330
 331    my %colors = (
 332      '+' => 'green',
 333      '-' => 'red',
 334    );
 335
 336    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
 337      for (split /\n/, $_[0]) {
 338        if ($config{color}) {
 339          print colored($_, $colors{substr($_, 0, 1)}), $/;
 340        } else {
 341          print $_, $/;
 342        }
 343      }
 344    }});
 345 }
 346
 347 sub usage {
 348   pod2usage(verbose => 99, sections => 'SYNOPSIS');
 349 }
 350
 351 sub list_all_tables {
 352   my ($db) = @_;
 353
 354   my @schemas = (undef, uniq apply { s{\..*}{} } grep { m{\.} } keys %{ $package_names{KIVITENDO} });
 355   my @tables;
 356
 357   foreach my $schema (@schemas) {
 358     $db->schema($schema);
 359     push @tables, map { $schema ? "${schema}.${_}" : $_ } $db->list_tables;
 360   }
 361
 362   $db->schema(undef);
 363
 364   return @tables;
 365 }
 366
 367 sub make_tables {
 368   my %tables_by_domain;
 369   if ($config{all}) {
 370     my @domains = $config{db} ? (uc $config{db}) : sort keys %package_names;
 371
 372     foreach my $domain (@domains) {
 373       my $db  = SL::DB::create(undef, $domain);
 374       $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } list_all_tables($db) ];
 375       $db->disconnect;
 376     }
 377
 378   } elsif (@ARGV) {
 379     %tables_by_domain = partition_by {
 380       my ($domain, $table) = split m{:};
 381       $table ? uc($domain) : 'KIVITENDO';
 382     } @ARGV;
 383
 384     foreach my $tables (values %tables_by_domain) {
 385       s{.*:}{} for @{ $tables };
 386     }
 387
 388   } else {
 389     error("You specified neither --all nor any specific tables.");
 390     usage();
 391   }
 392
 393   return %tables_by_domain;
 394 }
 395
 396 sub error {
 397   print STDERR colored(shift, 'red'), $/;
 398 }
 399
 400 sub notice {
 401   print @_, $/;
 402 }
 403
 404 sub check_errors_in_package_names {
 405   foreach my $domain (sort keys %package_names) {
 406     my @both = grep { $package_names{$domain}->{$_} } @{ $blacklist{$domain} || [] };
 407     next unless @both;
 408
 409     print "Error: domain '$domain': The following table names are present in both the black list and the package name hash: ", join(' ', sort @both), "\n";
 410     exit 1;
 411   }
 412 }
 413
 414 sub drop_and_create_test_database {
 415   my $db_cfg          = $::lx_office_conf{'testing/database'} || die 'testing/database missing';
 416
 417   my @dbi_options = (
 418     'dbi:Pg:dbname=' . $db_cfg->{template} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
 419     $db_cfg->{user},
 420     $db_cfg->{password},
 421     SL::DBConnect->get_options,
 422   );
 423
 424   $::auth->reset;
 425   my $dbh_template = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("No database connection to the template database: " . $DBI::errstr);
 426   my $auth_dbh     = $::auth->dbconnect(1);
 427
 428   if ($auth_dbh) {
 429     notice("Database exists; dropping");
 430     $auth_dbh->disconnect;
 431
 432     dbh_do($dbh_template, "DROP DATABASE \"" . $db_cfg->{db} . "\"", message => "Database could not be dropped");
 433
 434     $::auth->reset;
 435   }
 436
 437   notice("Creating database");
 438
 439   dbh_do($dbh_template, "CREATE DATABASE \"" . $db_cfg->{db} . "\" TEMPLATE \"" . $db_cfg->{template} . "\" ENCODING 'UNICODE'", message => "Database could not be created");
 440   $dbh_template->disconnect;
 441
 442   notice("Creating initial schema");
 443
 444   @dbi_options = (
 445     'dbi:Pg:dbname=' . $db_cfg->{db} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
 446     $db_cfg->{user},
 447     $db_cfg->{password},
 448     SL::DBConnect->get_options(PrintError => 0, PrintWarn => 0),
 449   );
 450
 451   my $dbh           = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("Database connection failed: " . $DBI::errstr);
 452   $::auth->{dbh} = $dbh;
 453   my $dbupdater  = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, silent => 1);
 454   my $coa        = 'Germany-DATEV-SKR03EU';
 455
 456   apply_dbupgrade($dbupdater, $dbh, "sql/lx-office.sql");
 457   apply_dbupgrade($dbupdater, $dbh, "sql/${coa}-chart.sql");
 458
 459   dbh_do($dbh, qq|UPDATE defaults SET coa = '${coa}', accounting_method = 'cash', profit_determination = 'income', inventory_system = 'periodic', curr = 'EUR'|);
 460   dbh_do($dbh, qq|CREATE TABLE schema_info (tag TEXT, login TEXT, itime TIMESTAMP DEFAULT now(), PRIMARY KEY (tag))|);
 461
 462   notice("Creating initial auth schema");
 463
 464   $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => 1);
 465   apply_dbupgrade($dbupdater, $dbh, 'sql/auth_db.sql');
 466
 467   apply_upgrades(auth => 1, dbh => $dbh);
 468
 469   notice("Creating client, user, group and employee");
 470
 471   dbh_do($dbh, qq|DELETE FROM auth.clients|);
 472   dbh_do($dbh, qq|INSERT INTO auth.clients (id, name, dbhost, dbport, dbname, dbuser, dbpasswd, is_default) VALUES (1, 'Unit-Tests', ?, ?, ?, ?, ?, TRUE)|,
 473          bind => [ @{ $db_cfg }{ qw(host port db user password) } ]);
 474   dbh_do($dbh, qq|INSERT INTO auth."user"         (id,        login)    VALUES (1, 'unittests')|);
 475   dbh_do($dbh, qq|INSERT INTO auth."group"        (id,        name)     VALUES (1, 'Vollzugriff')|);
 476   dbh_do($dbh, qq|INSERT INTO auth.clients_users  (client_id, user_id)  VALUES (1, 1)|);
 477   dbh_do($dbh, qq|INSERT INTO auth.clients_groups (client_id, group_id) VALUES (1, 1)|);
 478   dbh_do($dbh, qq|INSERT INTO auth.user_group     (user_id,   group_id) VALUES (1, 1)|);
 479
 480   my %config                 = (
 481     default_printer_id       => '',
 482     template_format          => '',
 483     default_media            => '',
 484     email                    => 'unit@tester',
 485     tel                      => '',
 486     dateformat               => 'dd.mm.yy',
 487     show_form_details        => '',
 488     name                     => 'Unit Tester',
 489     signature                => '',
 490     hide_cvar_search_options => '',
 491     numberformat             => '1.000,00',
 492     vclimit                  => 0,
 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