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     favorites                => '',
 493     copies                   => '',
 494     menustyle                => 'v3',
 495     fax                      => '',
 496     stylesheet               => 'lx-office-erp.css',
 497     mandatory_departments    => 0,
 498     countrycode              => 'de',
 499   );
 500
 501   my $sth = $dbh->prepare(qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (1, ?, ?)|) || BAIL_OUT($dbh->errstr);
 502   dbh_do($dbh, $sth, bind => [ $_, $config{$_} ]) for sort keys %config;
 503   $sth->finish;
 504
 505   $sth = $dbh->prepare(qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (1, ?, TRUE)|) || BAIL_OUT($dbh->errstr);
 506   dbh_do($dbh, $sth, bind => [ $_ ]) for sort $::auth->all_rights;
 507   $sth->finish;
 508
 509   dbh_do($dbh, qq|INSERT INTO employee (id, login, name) VALUES (1, 'unittests', 'Unit Tester')|);
 510
 511   $::auth->set_client(1) || BAIL_OUT("\$::auth->set_client(1) failed");
 512   %::myconfig = $::auth->read_user(login => 'unittests');
 513
 514   apply_upgrades(dbh => $dbh);
 515 }
 516
 517 sub apply_upgrades {
 518   my %params            = @_;
 519   my $dbupdater         = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => $params{auth});
 520   my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($params{dbh});
 521
 522   my $all = @unapplied_scripts;
 523   my $i;
 524   for my $script (@unapplied_scripts) {
 525     ++$i;
 526     print "\rUpgrade $i/$all";
 527     apply_dbupgrade($dbupdater, $params{dbh}, $script);
 528   }
 529   print " - done.\n";
 530 }
 531
 532 sub apply_dbupgrade {
 533   my ($dbupdater, $dbh, $control_or_file) = @_;
 534
 535   my $file    = ref($control_or_file) ? ("sql/Pg-upgrade2" . ($dbupdater->{auth} ? "-auth" : "") . "/$control_or_file->{file}") : $control_or_file;
 536   my $control = ref($control_or_file) ? $control_or_file                                                                        : undef;
 537
 538   my $error = $dbupdater->process_file($dbh, $file, $control);
 539
 540   die("Error applying $file: $error") if $error;
 541 }
 542
 543 sub dbh_do {
 544   my ($dbh, $query, %params) = @_;
 545
 546   if (ref($query)) {
 547     return if $query->execute(@{ $params{bind} || [] });
 548     die($dbh->errstr);
 549   }
 550
 551   return if $dbh->do($query, undef, @{ $params{bind} || [] });
 552
 553   die($params{message} . ": " . $dbh->errstr) if $params{message};
 554   die("Query failed: " . $dbh->errstr . " ; query: $query");
 555 }
 556
 557 parse_args(\%config);
 558 setup();
 559 check_errors_in_package_names();
 560
 561 my %tables_by_domain = make_tables();
 562
 563 foreach my $domain (keys %tables_by_domain) {
 564   my @tables         = @{ $tables_by_domain{$domain} };
 565   my @unknown_tables = grep { !$package_names{$domain}->{$_} } @tables;
 566   if (@unknown_tables) {
 567     error("The following tables do not have entries in \%SL::DB::Helper::Mappings::${domain}_package_names: " . join(' ', sort @unknown_tables));
 568     exit 1;
 569   }
 570
 571   process_table($domain, $_, $package_names{$domain}->{$_}) for @tables;
 572 }
 573
 574 1;
 575
 576 __END__
 577
 578 =encoding utf-8
 579
 580 =head1 NAME
 581
 582 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
 583
 584 =head1 SYNOPSIS
 585
 586   scripts/rose_auto_create_model.pl OPTIONS TARGET
 587
 588   # use other client than devel.client
 589   scripts/rose_auto_create_model.pl --test-client TARGET
 590   scripts/rose_auto_create_model.pl --client name-or-id TARGET
 591
 592   # TARGETS:
 593   # updates all models
 594   scripts/rose_auto_create_model.pl --all [--db db]
 595
 596   # updates only customer table, login taken from config
 597   scripts/rose_auto_create_model.pl customer
 598
 599   # updates only parts table, package will be Part
 600   scripts/rose_auto_create_model.pl parts=Part
 601
 602   # try to update parts, but don't do it. tell what would happen in detail
 603   scripts/rose_auto_create_model.pl --no-commit parts
 604
 605 =head1 DESCRIPTION
 606
 607 Rose::DB::Object comes with a nice function named auto initialization with code
 608 generation. The documentation of Rose describes it like this:
 609
 610 I<[...] auto-initializing metadata at runtime by querying the database has many
 611 caveats. An alternate approach is to query the database for metadata just once,
 612 and then generate the equivalent Perl code which can be pasted directly into
 613 the class definition in place of the call to auto_initialize.>
 614
 615 I<Like the auto-initialization process itself, perl code generation has a
 616 convenient wrapper method as well as separate methods for the individual parts.
 617 All of the perl code generation methods begin with "perl_", and they support
 618 some rudimentary code formatting options to help the code conform to you
 619 preferred style. Examples can be found with the documentation for each perl_*
 620 method.>
 621
 622 I<This hybrid approach to metadata population strikes a good balance between
 623 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
 624 initial class definition saves a lot of tedious typing. From that point on,
 625 manually correcting and maintaining the definition is a small price to pay for
 626 the decreased start-up cost, the ability to use the class in the absence of a
 627 database connection, and the piece of mind that comes from knowing that your
 628 class is stable, and won't change behind your back in response to an "action at
 629 a distance" (i.e., a database schema update).>
 630
 631 Unfortunately this reads easier than it is, since classes need to go into the
 632 right package and directory, certain stuff needs to be adjusted and table names
 633 need to be translated into their class names. This script will wrap all that
 634 behind a few simple options.
 635
 636 In the most basic version, just give it a login and a table name, and it will
 637 load the schema information for this table and create the appropriate class
 638 files, or update them if already present.
 639
 640 Each table has three associated files. A C<SL::DB::MetaSetup::*>
 641 class, which is a perl version of the schema definition, a
 642 C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
 643 file. The first one will be updated if the schema changes, the second
 644 and third ones will only be created if it they do not exist.
 645
 646 =head1 DATABASE NAMES AND TABLES
 647
 648 If you want to generate the data for specific tables only then you
 649 have to list them on the command line. The format is
 650 C<db-name:table-name>. The part C<db-name:> is optional and defaults
 651 to C<KIVITENDO:> – which means the tables in the default kivitendo
 652 database.
 653
 654 Valid database names are keys in the hash returned by
 655 L<SL::DB::Helper::Mappings/get_package_names>.
 656
 657 =head1 OPTIONS
 658
 659 =over 4
 660
 661 =item C<--test-client, -t>
 662
 663 Use the C<testing/database> to create a new testing database, and connect to
 664 the first client there. Overrides C<client>.
 665
 666 If neither C<test-client> nor C<client> are set, the config key C<devel/client>
 667 will be used.
 668
 669 =item C<--client, -c CLIENT>
 670
 671 Provide a client whose database settings are used. C<CLIENT> can be either a
 672 database ID or a client's name.
 673
 674 If neither C<test-client> nor C<client> are set, the config key C<devel/client>
 675 will be used.
 676
 677 =item C<--all, -a>
 678
 679 Process all tables from the database. Only those that are blacklistes in
 680 L<SL::DB::Helper::Mappings> are excluded.
 681
 682 =item C<--db db>
 683
 684 In combination with C<--all> causes all tables in the specific
 685 database to be processed, not in all databases.
 686
 687 =item C<--no-commit, -n>
 688
 689 =item C<--dry-run>
 690
 691 Do not write back generated files. This will do everything as usual but not
 692 actually modify any file.
 693
 694 =item C<--diff>
 695
 696 Displays diff for selected file, if file is present and newer file is
 697 different. Beware, does not imply C<--no-commit>.
 698
 699 =item C<--help, -h>
 700
 701 Print this help.
 702
 703 =item C<--quiet, -q>
 704
 705 Does not print extra information, such as skipped files that were not
 706 changed and errors where the auto initialization failed.
 707
 708 =back
 709
 710 =head1 BUGS
 711
 712 None yet.
 713
 714 =head1 AUTHOR
 715
 716 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 717 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 718
 719 =cut