rose_auto_create_model: Manager-Datei erstellen
[kivitendo-erp.git] / 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(any);
17 use Pod::Usage;
18 use Term::ANSIColor;
19
20 use SL::Auth;
21 use SL::DBUtils;
22 use SL::DB;
23 use SL::Form;
24 use SL::Locale;
25 use SL::LXDebug;
26 use SL::LxOfficeConf;
27 use SL::DB::Helper::ALL;
28 use SL::DB::Helper::Mappings;
29
30 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
31 my %package_names = SL::DB::Helper::Mappings->get_package_names;
32
33 our $form;
34 our $auth;
35 our %lx_office_conf;
36
37 our $script =  __FILE__;
38 $script     =~ s:.*/::;
39
40 $OUTPUT_AUTOFLUSH       = 1;
41 $Data::Dumper::Sortkeys = 1;
42
43 our $meta_path    = "SL/DB/MetaSetup";
44 our $manager_path = "SL/DB/Manager";
45
46 my %config;
47
48 our %foreign_key_name_map = (
49   oe                   => { payment => 'payment_terms', },
50   ar                   => { payment => 'payment_terms', },
51   ap                   => { payment => 'payment_terms', },
52
53   orderitems           => { parts => 'part', trans => 'order', },
54   delivery_order_items => { parts => 'part' },
55   invoice              => { parts => 'part' },
56
57   periodic_invoices_configs => { oe => 'order' },
58 );
59
60 sub setup {
61
62   SL::LxOfficeConf->read;
63
64   my $client = $config{client} || $::lx_office_conf{devel}{client};
65
66   if (!$client) {
67     error("No client found in config. Please provide a client:");
68     usage();
69   }
70
71   $::lxdebug      = LXDebug->new();
72   $::locale       = Locale->new("de");
73   $::form         = new Form;
74   $form->{script} = 'rose_meta_data.pl';
75   $::auth         = SL::Auth->new();
76
77   if (!$::auth->set_client($client)) {
78     error("No client with ID or name '$client' found in config. Please provide a client:");
79     usage();
80   }
81
82   foreach (($meta_path, $manager_path)) {
83     mkdir $_ unless -d;
84   }
85 }
86
87 sub process_table {
88   my @spec       =  split(/=/, shift, 2);
89   my $table      =  $spec[0];
90   my $schema     = '';
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";
97
98   my $schema_str = $schema ? <<CODE : '';
99 __PACKAGE__->meta->schema('$schema');
100 CODE
101
102   eval <<CODE;
103     package SL::DB::AUTO::$package;
104     use SL::DB::Object;
105     use base qw(SL::DB::Object);
106
107     __PACKAGE__->meta->table('$table');
108     $schema_str
109     __PACKAGE__->meta->auto_initialize;
110
111 CODE
112
113   if ($EVAL_ERROR) {
114     error("Error in execution for table '$table'");
115     error("'$EVAL_ERROR'") unless $config{quiet};
116     return;
117   }
118
119   my %args = (indent => 2, use_setup => 0);
120
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;
124
125
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;
131   }
132
133   # patch foreign keys
134   my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
135   $foreign_key_definition =~ s/::AUTO::/::/g;
136
137   if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
138     my ($start, $end) = ($-[0], $+[0]);
139
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;
142     }
143
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)";
149
150       substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;;
151     }
152
153     substr($definition, $start, $end - $start) = $foreign_key_definition;
154   }
155
156   $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;
157
158   my $full_definition = <<CODE;
159 # This file has been auto-generated. Do not modify it; it will be overwritten
160 # by $::script automatically.
161 $definition;
162 CODE
163
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.
167
168 package SL::DB::${package};
169
170 use strict;
171
172 use SL::DB::MetaSetup::${package};
173 use SL::DB::Manager::${package};
174
175 __PACKAGE__->meta->initialize;
176
177 1;
178 CODE
179
180   my $file_exists = -f $meta_file;
181   if ($file_exists) {
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};
189       return;
190     }
191
192     show_diff(\$orig_file, \$full_definition) if $config{show_diff};
193   }
194
195   if (!$config{nocommit}) {
196     open my $out, ">", $meta_file || die;
197     print $out $full_definition;
198   }
199
200   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
201
202   return if -f $file;
203
204   if (!$config{nocommit}) {
205     open my $out, ">", $file || die;
206     print $out $meta_definition;
207   }
208
209   notice("File '$file' created as well.");
210
211   return if -f $mngr_file;
212
213   if (!$config{nocommit}) {
214     open my $out, ">", $mngr_file || die;
215     print $out <<EOT;
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.
218
219 package SL::DB::Manager::${package};
220
221 use strict;
222
223 use SL::DB::Helper::Manager;
224 use base qw(SL::DB::Helper::Manager);
225
226 sub object_class { 'SL::DB::${package}' }
227
228 __PACKAGE__->make_manager_methods;
229
230 1;
231 EOT
232   }
233
234   notice("File '$mngr_file' created as well.");
235 }
236
237 sub parse_args {
238   my ($options) = @_;
239   GetOptions(
240     'client=s'          => \ my $client,
241     all                 => \ my $all,
242     'no-commit|dry-run' => \ my $nocommit,
243     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
244     quiet               => \ my $quiet,
245     diff                => \ my $diff,
246   );
247
248   $options->{client}   = $client;
249   $options->{all}      = $all;
250   $options->{nocommit} = $nocommit;
251   $options->{quiet}    = $quiet;
252   $options->{color}    = -t STDOUT ? 1 : 0;
253
254   if ($diff) {
255     if (eval { require Text::Diff; 1 }) {
256       $options->{show_diff} = 1;
257     } else {
258       error('Could not load Text::Diff. Sorry, no diffs for you.');
259     }
260   }
261 }
262
263 sub show_diff {
264    my ($text_a, $text_b) = @_;
265
266    my %colors = (
267      '+' => 'green',
268      '-' => 'red',
269    );
270
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)}), $/;
275        } else {
276          print $_, $/;
277        }
278      }
279    }});
280 }
281
282 sub usage {
283   pod2usage(verbose => 99, sections => 'SYNOPSIS');
284 }
285
286 sub make_tables {
287   my @tables;
288   if ($config{all}) {
289     my $db  = SL::DB::create(undef, 'KIVITENDO');
290     @tables =
291       map { $package_names{KIVITENDO}->{$_} ? "$_=" . $package_names{KIVITENDO}->{$_} : $_ }
292       grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{KIVITENDO} } }
293       $db->list_tables;
294   } elsif (@ARGV) {
295     @tables = @ARGV;
296   } else {
297     error("You specified neither --all nor any specific tables.");
298     usage();
299   }
300
301   @tables;
302 }
303
304 sub error {
305   print STDERR colored(shift, 'red'), $/;
306 }
307
308 sub notice {
309   print @_, $/;
310 }
311
312 parse_args(\%config);
313 setup();
314 my @tables = make_tables();
315
316 for my $table (@tables) {
317   # add default model name unless model name is given or no defaults exists
318   $table .= '=' . $package_names{KIVITENDO}->{lc $table} if $table !~ /=/ && $package_names{KIVITENDO}->{lc $table};
319
320   process_table($table);
321 }
322
323 1;
324
325 __END__
326
327 =encoding utf-8
328
329 =head1 NAME
330
331 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
332
333 =head1 SYNOPSIS
334
335   scripts/rose_create_model.pl --client name-or-id table1[=package1] [table2[=package2] ...]
336   scripts/rose_create_model.pl --client name-or-id [--all|-a]
337
338   # updates all models
339   scripts/rose_create_model.pl --client name-or-id --all
340
341   # updates only customer table, login taken from config
342   scripts/rose_create_model.pl customer
343
344   # updates only parts table, package will be Part
345   scripts/rose_create_model.pl parts=Part
346
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
349
350 =head1 DESCRIPTION
351
352 Rose::DB::Object comes with a nice function named auto initialization with code
353 generation. The documentation of Rose describes it like this:
354
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.>
359
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_*
365 method.>
366
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).>
375
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.
380
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.
384
385 Each table has two associated files. A C<SL::DB::MetaSetup::*> class, which is
386 a perl version of the schema definition, and a C<SL::DB::*> class file. The
387 first one will be updated if the schema changes, the second one will only be
388 created if it does not exist.
389
390 =head1 OPTIONS
391
392 =over 4
393
394 =item C<--client, -c CLIENT>
395
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.
399
400 Note that C<CLIENT> can be either a database ID or a client's name.
401
402 =item C<--all, -a>
403
404 Process all tables from the database. Only those that are blacklistes in
405 L<SL::DB::Helper::Mappings> are excluded.
406
407 =item C<--no-commit, -n>
408
409 =item C<--dry-run>
410
411 Do not write back generated files. This will do everything as usual but not
412 actually modify any file.
413
414 =item C<--diff>
415
416 Displays diff for selected file, if file is present and newer file is
417 different. Beware, does not imply C<--no-commit>.
418
419 =item C<--help, -h>
420
421 Print this help.
422
423 =item C<--quiet, -q>
424
425 Does not print extra information, such as skipped files that were not
426 changed and errors where the auto initialization failed.
427
428 =back
429
430 =head1 BUGS
431
432 None yet.
433
434 =head1 AUTHOR
435
436 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
437
438 =cut