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' },
57 periodic_invoices_configs => { oe => 'order' },
62 SL::LxOfficeConf->read;
64 my $client = $config{client} || $::lx_office_conf{devel}{client};
67 error("No client found in config. Please provide a client:");
71 $::lxdebug = LXDebug->new();
72 $::locale = Locale->new("de");
74 $form->{script} = 'rose_meta_data.pl';
75 $::auth = SL::Auth->new();
77 if (!$::auth->set_client($client)) {
78 error("No client with ID or name '$client' found in config. Please provide a client:");
82 foreach (($meta_path, $manager_path)) {
91 ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
92 my $package = ucfirst($spec[1] || $spec[0]);
93 $package =~ s/_+(.)/uc($1)/ge;
94 my $meta_file = "${meta_path}/${package}.pm";
95 my $mngr_file = "${manager_path}/${package}.pm";
96 my $file = "SL/DB/${package}.pm";
98 my $schema_str = $schema ? <<CODE : '';
99 __PACKAGE__->meta->schema('$schema');
103 package SL::DB::AUTO::$package;
105 use base qw(SL::DB::Object);
107 __PACKAGE__->meta->table('$table');
109 __PACKAGE__->meta->auto_initialize;
114 error("Error in execution for table '$table'");
115 error("'$EVAL_ERROR'") unless $config{quiet};
119 my %args = (indent => 2, use_setup => 0);
121 my $definition = "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
122 $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;
123 $definition =~ s/::AUTO::/::/g;
126 # Sort column definitions alphabetically
127 if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
128 my ($start, $end) = ($-[1], $+[1]);
129 my $sorted_columns = join "\n", sort split m/\n/, $1;
130 substr $definition, $start, $end - $start, $sorted_columns;
134 my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
135 $foreign_key_definition =~ s/::AUTO::/::/g;
137 if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
138 my ($start, $end) = ($-[0], $+[0]);
140 while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
141 $foreign_key_definition =~ s/^ \s \s ${auto_generated_name} \b/ ${desired_name}/msx;
144 # Sort foreign key definitions alphabetically
145 if ($foreign_key_definition =~ m/\(\n(.+)\n\)/s) {
146 my ($list_start, $list_end) = ($-[0], $+[0]);
147 my @foreign_keys = split m/\n\n/m, $1;
148 my $sorted_foreign_keys = "(\n" . join("\n\n", sort @foreign_keys) . "\n)";
150 substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;;
153 substr($definition, $start, $end - $start) = $foreign_key_definition;
156 $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
158 my $full_definition = <<CODE;
159 # This file has been auto-generated. Do not modify it; it will be overwritten
160 # by $::script automatically.
164 my $meta_definition = <<CODE;
165 # This file has been auto-generated only because it didn't exist.
166 # Feel free to modify it at will; it will not be overwritten automatically.
168 package SL::DB::${package};
172 use SL::DB::MetaSetup::${package};
173 use SL::DB::Manager::${package};
175 __PACKAGE__->meta->initialize;
180 my $file_exists = -f $meta_file;
182 my $old_size = -s $meta_file;
183 my $orig_file = do { local(@ARGV, $/) = ($meta_file); <> };
184 my $old_md5 = md5_hex($orig_file);
185 my $new_size = length $full_definition;
186 my $new_md5 = md5_hex($full_definition);
187 if ($old_size == $new_size && $old_md5 == $new_md5) {
188 notice("No changes in $meta_file, skipping.") unless $config{quiet};
192 show_diff(\$orig_file, \$full_definition) if $config{show_diff};
195 if (!$config{nocommit}) {
196 open my $out, ">", $meta_file || die;
197 print $out $full_definition;
200 notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
204 if (!$config{nocommit}) {
205 open my $out, ">", $file || die;
206 print $out $meta_definition;
209 notice("File '$file' created as well.");
211 return if -f $mngr_file;
213 if (!$config{nocommit}) {
214 open my $out, ">", $mngr_file || die;
216 # This file has been auto-generated only because it didn't exist.
217 # Feel free to modify it at will; it will not be overwritten automatically.
219 package SL::DB::Manager::${package};
223 use SL::DB::Helper::Manager;
224 use base qw(SL::DB::Helper::Manager);
226 sub object_class { 'SL::DB::${package}' }
228 __PACKAGE__->make_manager_methods;
234 notice("File '$mngr_file' created as well.");
240 'client=s' => \ my $client,
242 'no-commit|dry-run' => \ my $nocommit,
243 help => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
244 quiet => \ my $quiet,
248 $options->{client} = $client;
249 $options->{all} = $all;
250 $options->{nocommit} = $nocommit;
251 $options->{quiet} = $quiet;
252 $options->{color} = -t STDOUT ? 1 : 0;
255 if (eval { require Text::Diff; 1 }) {
256 $options->{show_diff} = 1;
258 error('Could not load Text::Diff. Sorry, no diffs for you.');
264 my ($text_a, $text_b) = @_;
271 Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
272 for (split /\n/, $_[0]) {
273 if ($config{color}) {
274 print colored($_, $colors{substr($_, 0, 1)}), $/;
283 pod2usage(verbose => 99, sections => 'SYNOPSIS');
289 my $db = SL::DB::create(undef, 'KIVITENDO');
290 @tables = grep { my $table = $_; none { $_ eq $table } @{ $blacklist{KIVITENDO} } } $db->list_tables;
295 error("You specified neither --all nor any specific tables.");
303 print STDERR colored(shift, 'red'), $/;
310 parse_args(\%config);
312 my @tables = make_tables();
314 my @unknown_tables = grep { !$package_names{KIVITENDO}->{$_} } @tables;
315 if (@unknown_tables) {
316 error("The following tables do not have entries in \%SL::DB::Helper::Mappings::kivitendo_package_names: " . join(' ', sort @unknown_tables));
320 process_table($_, $package_names{KIVITENDO}->{$_}) for @tables;
330 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
334 scripts/rose_create_model.pl --client name-or-id table1 [table2 ...]
335 scripts/rose_create_model.pl --client name-or-id [--all|-a]
338 scripts/rose_create_model.pl --client name-or-id --all
340 # updates only customer table, login taken from config
341 scripts/rose_create_model.pl customer
343 # updates only parts table, package will be Part
344 scripts/rose_create_model.pl parts=Part
346 # try to update parts, but don't do it. tell what would happen in detail
347 scripts/rose_create_model.pl --no-commit parts
351 Rose::DB::Object comes with a nice function named auto initialization with code
352 generation. The documentation of Rose describes it like this:
354 I<[...] auto-initializing metadata at runtime by querying the database has many
355 caveats. An alternate approach is to query the database for metadata just once,
356 and then generate the equivalent Perl code which can be pasted directly into
357 the class definition in place of the call to auto_initialize.>
359 I<Like the auto-initialization process itself, perl code generation has a
360 convenient wrapper method as well as separate methods for the individual parts.
361 All of the perl code generation methods begin with "perl_", and they support
362 some rudimentary code formatting options to help the code conform to you
363 preferred style. Examples can be found with the documentation for each perl_*
366 I<This hybrid approach to metadata population strikes a good balance between
367 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
368 initial class definition saves a lot of tedious typing. From that point on,
369 manually correcting and maintaining the definition is a small price to pay for
370 the decreased start-up cost, the ability to use the class in the absence of a
371 database connection, and the piece of mind that comes from knowing that your
372 class is stable, and won't change behind your back in response to an "action at
373 a distance" (i.e., a database schema update).>
375 Unfortunately this reads easier than it is, since classes need to go into the
376 right package and directory, certain stuff needs to be adjusted and table names
377 need to be translated into their class names. This script will wrap all that
378 behind a few simple options.
380 In the most basic version, just give it a login and a table name, and it will
381 load the schema information for this table and create the appropriate class
382 files, or update them if already present.
384 Each table has three associated files. A C<SL::DB::MetaSetup::*>
385 class, which is a perl version of the schema definition, a
386 C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
387 file. The first one will be updated if the schema changes, the second
388 and third ones will only be created if it they do not exist.
394 =item C<--client, -c CLIENT>
396 Provide a client whose database settings are used. If not present the
397 client is loaded from the config key C<devel/client>. If that too is
398 not found, an error is thrown.
400 Note that C<CLIENT> can be either a database ID or a client's name.
404 Process all tables from the database. Only those that are blacklistes in
405 L<SL::DB::Helper::Mappings> are excluded.
407 =item C<--no-commit, -n>
411 Do not write back generated files. This will do everything as usual but not
412 actually modify any file.
416 Displays diff for selected file, if file is present and newer file is
417 different. Beware, does not imply C<--no-commit>.
425 Does not print extra information, such as skipped files that were not
426 changed and errors where the auto initialization failed.
436 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
437 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>