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.
10 use CGI qw( -no_xhtml);
13 use Digest::MD5 qw(md5_hex);
14 use English qw( -no_match_vars );
16 use List::MoreUtils qw(none);
27 use SL::DB::Helper::ALL;
28 use SL::DB::Helper::Mappings;
30 my %blacklist = SL::DB::Helper::Mappings->get_blacklist;
31 my %package_names = SL::DB::Helper::Mappings->get_package_names;
37 our $script = __FILE__;
40 $OUTPUT_AUTOFLUSH = 1;
41 $Data::Dumper::Sortkeys = 1;
43 our $meta_path = "SL/DB/MetaSetup";
44 our $manager_path = "SL/DB/Manager";
48 our %foreign_key_name_map = (
49 oe => { payment => 'payment_terms', },
50 ar => { payment => 'payment_terms', },
51 ap => { payment => 'payment_terms', },
53 orderitems => { parts => 'part', trans => 'order', },
54 delivery_order_items => { parts => 'part' },
55 invoice => { parts => 'part' },
56 follow_ups => { 'employee_obj' => 'created_for' },
58 periodic_invoices_configs => { oe => 'order' },
63 SL::LxOfficeConf->read;
65 my $client = $config{client} || $::lx_office_conf{devel}{client};
68 error("No client found in config. Please provide a client:");
72 $::lxdebug = LXDebug->new();
73 $::locale = Locale->new("de");
75 $form->{script} = 'rose_meta_data.pl';
76 $::auth = SL::Auth->new();
78 if (!$::auth->set_client($client)) {
79 error("No client with ID or name '$client' found in config. Please provide a client:");
83 foreach (($meta_path, $manager_path)) {
92 ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
93 my $package = ucfirst($spec[1] || $spec[0]);
94 $package =~ s/_+(.)/uc($1)/ge;
95 my $meta_file = "${meta_path}/${package}.pm";
96 my $mngr_file = "${manager_path}/${package}.pm";
97 my $file = "SL/DB/${package}.pm";
99 my $schema_str = $schema ? <<CODE : '';
100 __PACKAGE__->meta->schema('$schema');
104 package SL::DB::AUTO::$package;
106 use base qw(SL::DB::Object);
108 __PACKAGE__->meta->table('$table');
110 __PACKAGE__->meta->auto_initialize;
115 error("Error in execution for table '$table'");
116 error("'$EVAL_ERROR'") unless $config{quiet};
120 my %args = (indent => 2, use_setup => 0);
122 my $definition = "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
123 $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;
124 $definition =~ s/::AUTO::/::/g;
127 # Sort column definitions alphabetically
128 if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
129 my ($start, $end) = ($-[1], $+[1]);
130 my $sorted_columns = join "\n", sort split m/\n/, $1;
131 substr $definition, $start, $end - $start, $sorted_columns;
135 my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
136 $foreign_key_definition =~ s/::AUTO::/::/g;
138 if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
139 my ($start, $end) = ($-[0], $+[0]);
141 while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
142 $foreign_key_definition =~ s/^ \s \s ${auto_generated_name} \b/ ${desired_name}/msx;
145 # Sort foreign key definitions alphabetically
146 if ($foreign_key_definition =~ m/\(\n(.+)\n\)/s) {
147 my ($list_start, $list_end) = ($-[0], $+[0]);
148 my @foreign_keys = split m/\n\n/m, $1;
149 my $sorted_foreign_keys = "(\n" . join("\n\n", sort @foreign_keys) . "\n)";
151 substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;;
154 substr($definition, $start, $end - $start) = $foreign_key_definition;
157 $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
159 my $full_definition = <<CODE;
160 # This file has been auto-generated. Do not modify it; it will be overwritten
161 # by $::script automatically.
165 my $meta_definition = <<CODE;
166 # This file has been auto-generated only because it didn't exist.
167 # Feel free to modify it at will; it will not be overwritten automatically.
169 package SL::DB::${package};
173 use SL::DB::MetaSetup::${package};
174 use SL::DB::Manager::${package};
176 __PACKAGE__->meta->initialize;
181 my $file_exists = -f $meta_file;
183 my $old_size = -s $meta_file;
184 my $orig_file = do { local(@ARGV, $/) = ($meta_file); <> };
185 my $old_md5 = md5_hex($orig_file);
186 my $new_size = length $full_definition;
187 my $new_md5 = md5_hex($full_definition);
188 if ($old_size == $new_size && $old_md5 == $new_md5) {
189 notice("No changes in $meta_file, skipping.") unless $config{quiet};
193 show_diff(\$orig_file, \$full_definition) if $config{show_diff};
196 if (!$config{nocommit}) {
197 open my $out, ">", $meta_file || die;
198 print $out $full_definition;
201 notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
205 if (!$config{nocommit}) {
206 open my $out, ">", $file || die;
207 print $out $meta_definition;
210 notice("File '$file' created as well.");
212 return if -f $mngr_file;
214 if (!$config{nocommit}) {
215 open my $out, ">", $mngr_file || die;
217 # This file has been auto-generated only because it didn't exist.
218 # Feel free to modify it at will; it will not be overwritten automatically.
220 package SL::DB::Manager::${package};
224 use SL::DB::Helper::Manager;
225 use base qw(SL::DB::Helper::Manager);
227 sub object_class { 'SL::DB::${package}' }
229 __PACKAGE__->make_manager_methods;
235 notice("File '$mngr_file' created as well.");
241 'client=s' => \ my $client,
243 'no-commit|dry-run' => \ my $nocommit,
244 help => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
245 quiet => \ my $quiet,
249 $options->{client} = $client;
250 $options->{all} = $all;
251 $options->{nocommit} = $nocommit;
252 $options->{quiet} = $quiet;
253 $options->{color} = -t STDOUT ? 1 : 0;
256 if (eval { require Text::Diff; 1 }) {
257 $options->{show_diff} = 1;
259 error('Could not load Text::Diff. Sorry, no diffs for you.');
265 my ($text_a, $text_b) = @_;
272 Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
273 for (split /\n/, $_[0]) {
274 if ($config{color}) {
275 print colored($_, $colors{substr($_, 0, 1)}), $/;
284 pod2usage(verbose => 99, sections => 'SYNOPSIS');
290 my $db = SL::DB::create(undef, 'KIVITENDO');
291 @tables = grep { my $table = $_; none { $_ eq $table } @{ $blacklist{KIVITENDO} } } $db->list_tables;
296 error("You specified neither --all nor any specific tables.");
304 print STDERR colored(shift, 'red'), $/;
311 parse_args(\%config);
313 my @tables = make_tables();
315 my @unknown_tables = grep { !$package_names{KIVITENDO}->{$_} } @tables;
316 if (@unknown_tables) {
317 error("The following tables do not have entries in \%SL::DB::Helper::Mappings::kivitendo_package_names: " . join(' ', sort @unknown_tables));
321 process_table($_, $package_names{KIVITENDO}->{$_}) for @tables;
331 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
335 scripts/rose_create_model.pl --client name-or-id table1 [table2 ...]
336 scripts/rose_create_model.pl --client name-or-id [--all|-a]
339 scripts/rose_create_model.pl --client name-or-id --all
341 # updates only customer table, login taken from config
342 scripts/rose_create_model.pl customer
344 # updates only parts table, package will be Part
345 scripts/rose_create_model.pl parts=Part
347 # try to update parts, but don't do it. tell what would happen in detail
348 scripts/rose_create_model.pl --no-commit parts
352 Rose::DB::Object comes with a nice function named auto initialization with code
353 generation. The documentation of Rose describes it like this:
355 I<[...] auto-initializing metadata at runtime by querying the database has many
356 caveats. An alternate approach is to query the database for metadata just once,
357 and then generate the equivalent Perl code which can be pasted directly into
358 the class definition in place of the call to auto_initialize.>
360 I<Like the auto-initialization process itself, perl code generation has a
361 convenient wrapper method as well as separate methods for the individual parts.
362 All of the perl code generation methods begin with "perl_", and they support
363 some rudimentary code formatting options to help the code conform to you
364 preferred style. Examples can be found with the documentation for each perl_*
367 I<This hybrid approach to metadata population strikes a good balance between
368 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
369 initial class definition saves a lot of tedious typing. From that point on,
370 manually correcting and maintaining the definition is a small price to pay for
371 the decreased start-up cost, the ability to use the class in the absence of a
372 database connection, and the piece of mind that comes from knowing that your
373 class is stable, and won't change behind your back in response to an "action at
374 a distance" (i.e., a database schema update).>
376 Unfortunately this reads easier than it is, since classes need to go into the
377 right package and directory, certain stuff needs to be adjusted and table names
378 need to be translated into their class names. This script will wrap all that
379 behind a few simple options.
381 In the most basic version, just give it a login and a table name, and it will
382 load the schema information for this table and create the appropriate class
383 files, or update them if already present.
385 Each table has three associated files. A C<SL::DB::MetaSetup::*>
386 class, which is a perl version of the schema definition, a
387 C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
388 file. The first one will be updated if the schema changes, the second
389 and third ones will only be created if it they do not exist.
395 =item C<--client, -c CLIENT>
397 Provide a client whose database settings are used. If not present the
398 client is loaded from the config key C<devel/client>. If that too is
399 not found, an error is thrown.
401 Note that C<CLIENT> can be either a database ID or a client's name.
405 Process all tables from the database. Only those that are blacklistes in
406 L<SL::DB::Helper::Mappings> are excluded.
408 =item C<--no-commit, -n>
412 Do not write back generated files. This will do everything as usual but not
413 actually modify any file.
417 Displays diff for selected file, if file is present and newer file is
418 different. Beware, does not imply C<--no-commit>.
426 Does not print extra information, such as skipped files that were not
427 changed and errors where the auto initialization failed.
437 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
438 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>