scripts/rose_auto_create_model.pl

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