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(any);
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";
47 our %foreign_key_name_map = (
48 oe => { payment => 'payment_terms', },
49 ar => { payment => 'payment_terms', },
50 ap => { payment => 'payment_terms', },
52 orderitems => { parts => 'part', trans => 'order', },
53 delivery_order_items => { parts => 'part' },
54 invoice => { parts => 'part' },
56 periodic_invoices_configs => { oe => 'order' },
61 SL::LxOfficeConf->read;
63 my $client = $config{client} || $::lx_office_conf{devel}{client};
66 error("No client found in config. Please provide a client:");
70 $::lxdebug = LXDebug->new();
71 $::locale = Locale->new("de");
73 $form->{script} = 'rose_meta_data.pl';
74 $::auth = SL::Auth->new();
76 if (!$::auth->set_client($client)) {
77 error("No client with ID or name '$client' found in config. Please provide a client:");
81 mkdir $meta_path unless -d $meta_path;
85 my @spec = split(/=/, shift, 2);
88 ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
89 my $package = ucfirst($spec[1] || $spec[0]);
90 $package =~ s/_+(.)/uc($1)/ge;
91 my $meta_file = "${meta_path}/${package}.pm";
92 my $file = "SL/DB/${package}.pm";
94 my $schema_str = $schema ? <<CODE : '';
95 __PACKAGE__->meta->schema('$schema');
98 my $definition = eval <<CODE;
99 package SL::DB::AUTO::$package;
101 use base qw(SL::DB::Object);
103 __PACKAGE__->meta->table('$table');
105 __PACKAGE__->meta->auto_initialize;
107 __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'
111 error("Error in execution for table '$table'");
112 error("'$EVAL_ERROR'") unless $config{quiet};
116 $definition =~ s/::AUTO::/::/g;
118 while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
119 $definition =~ s/( foreign_keys \s*=> \s*\[ .* ^\s+ ) ${auto_generated_name} \b/${1}${desired_name}/msx;
122 $definition =~ s/(table\s*=>.*?\n)/$1 schema => '${schema}',\n/ if $schema;
124 my $full_definition = <<CODE;
125 # This file has been auto-generated. Do not modify it; it will be overwritten
126 # by $::script automatically.
130 my $meta_definition = <<CODE;
131 # This file has been auto-generated only because it didn't exist.
132 # Feel free to modify it at will; it will not be overwritten automatically.
134 package SL::DB::${package};
138 use SL::DB::MetaSetup::${package};
140 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
141 __PACKAGE__->meta->make_manager_class;
146 my $file_exists = -f $meta_file;
148 my $old_size = -s $meta_file;
149 my $orig_file = do { local(@ARGV, $/) = ($meta_file); <> };
150 my $old_md5 = md5_hex($orig_file);
151 my $new_size = length $full_definition;
152 my $new_md5 = md5_hex($full_definition);
153 if ($old_size == $new_size && $old_md5 == $new_md5) {
154 notice("No changes in $meta_file, skipping.") unless $config{quiet};
158 show_diff(\$orig_file, \$full_definition) if $config{show_diff};
161 if (!$config{nocommit}) {
162 open my $out, ">", $meta_file || die;
163 print $out $full_definition;
166 notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
169 if (!$config{nocommit}) {
170 open my $out, ">", $file || die;
171 print $out $meta_definition;
174 notice("File '$file' created as well.");
181 'client=s' => \ my $client,
183 'no-commit|dry-run' => \ my $nocommit,
184 help => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
185 quiet => \ my $quiet,
187 'color!' => \ my $color,
190 $options->{client} = $client;
191 $options->{all} = $all;
192 $options->{nocommit} = $nocommit;
193 $options->{quiet} = $quiet;
194 $options->{color} = defined $color ? $color : 1;
197 if (eval { require Text::Diff; 1 }) {
198 $options->{show_diff} = 1;
200 error('Could not load Text::Diff. Sorry, no diffs for you.');
206 my ($text_a, $text_b) = @_;
213 Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
214 for (split /\n/, $_[0]) {
215 if ($config{color}) {
216 print colored($_, $colors{substr($_, 0, 1)}), $/;
225 pod2usage(verbose => 99, sections => 'SYNOPSIS');
231 my $db = SL::DB::create(undef, 'KIVITENDO');
233 map { $package_names{KIVITENDO}->{$_} ? "$_=" . $package_names{KIVITENDO}->{$_} : $_ }
234 grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{KIVITENDO} } }
239 error("You specified neither --all nor any specific tables.");
247 print STDERR colored(shift, 'red'), $/;
254 parse_args(\%config);
256 my @tables = make_tables();
258 for my $table (@tables) {
259 # add default model name unless model name is given or no defaults exists
260 $table .= '=' . $package_names{KIVITENDO}->{lc $table} if $table !~ /=/ && $package_names{KIVITENDO}->{lc $table};
262 process_table($table);
273 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
277 scripts/rose_create_model.pl --client name-or-id table1[=package1] [table2[=package2] ...]
278 scripts/rose_create_model.pl --client name-or-id [--all|-a]
281 scripts/rose_create_model.pl --client name-or-id --all
283 # updates only customer table, login taken from config
284 scripts/rose_create_model.pl customer
286 # updates only parts table, package will be Part
287 scripts/rose_create_model.pl parts=Part
289 # try to update parts, but don't do it. tell what would happen in detail
290 scripts/rose_create_model.pl --no-commit parts
294 Rose::DB::Object comes with a nice function named auto initialization with code
295 generation. The documentation of Rose describes it like this:
297 I<[...] auto-initializing metadata at runtime by querying the database has many
298 caveats. An alternate approach is to query the database for metadata just once,
299 and then generate the equivalent Perl code which can be pasted directly into
300 the class definition in place of the call to auto_initialize.>
302 I<Like the auto-initialization process itself, perl code generation has a
303 convenient wrapper method as well as separate methods for the individual parts.
304 All of the perl code generation methods begin with "perl_", and they support
305 some rudimentary code formatting options to help the code conform to you
306 preferred style. Examples can be found with the documentation for each perl_*
309 I<This hybrid approach to metadata population strikes a good balance between
310 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
311 initial class definition saves a lot of tedious typing. From that point on,
312 manually correcting and maintaining the definition is a small price to pay for
313 the decreased start-up cost, the ability to use the class in the absence of a
314 database connection, and the piece of mind that comes from knowing that your
315 class is stable, and won't change behind your back in response to an "action at
316 a distance" (i.e., a database schema update).>
318 Unfortunately this reads easier than it is, since classes need to go into the
319 right package and directory, certain stuff needs to be adjusted and table names
320 need to be translated into their class names. This script will wrap all that
321 behind a few simple options.
323 In the most basic version, just give it a login and a table name, and it will
324 load the schema information for this table and create the appropriate class
325 files, or update them if already present.
327 Each table has two associated files. A C<SL::DB::MetaSetup::*> class, which is
328 a perl version of the schema definition, and a C<SL::DB::*> class file. The
329 first one will be updated if the schema changes, the second one will only be
330 created if it does not exist.
336 =item C<--client, -c CLIENT>
338 Provide a client whose database settings are used. If not present the
339 client is loaded from the config key C<devel/client>. If that too is
340 not found, an error is thrown.
342 Note that C<CLIENT> can be either a database ID or a client's name.
346 Process all tables from the database. Only those that are blacklistes in
347 L<SL::DB::Helper::Mappings> are excluded.
349 =item C<--no-commit, -n>
353 Do not write back generated files. This will do everything as usual but not
354 actually modify any file.
358 Displays diff for selected file, if file is present and newer file is
359 different. Beware, does not imply C<--no-commit>.
367 Does not print extra information, such as skipped files that were not
368 changed and errors where the auto initialization failed.
378 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>