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