Rose: Fremdschlüsselbenennung fixen
[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
45 my %config;
46
47 our %foreign_key_name_map = (
48   oe                   => { payment => 'payment_terms', },
49   ar                   => { payment => 'payment_terms', },
50   ap                   => { payment => 'payment_terms', },
51
52   orderitems           => { parts => 'part', trans => 'order', },
53   delivery_order_items => { parts => 'part' },
54   invoice              => { parts => 'part' },
55 );
56
57 sub setup {
58
59   SL::LxOfficeConf->read;
60
61   my $login     = $config{login} || $::lx_office_conf{devel}{login};
62
63   if (!$login) {
64     error("No login found in config. Please provide a login:");
65     usage();
66   }
67
68   $::lxdebug      = LXDebug->new();
69   $::locale       = Locale->new("de");
70   $::form         = new Form;
71   $::auth         = SL::Auth->new();
72   $::user         = User->new(login => $login);
73   %::myconfig     = $auth->read_user(login => $login);
74   $::request      = { cgi => CGI->new({}) };
75   $form->{script} = 'rose_meta_data.pl';
76   $form->{login}  = $login;
77
78   map { $form->{$_} = $::myconfig{$_} } qw(stylesheet charset);
79
80   mkdir $meta_path unless -d $meta_path;
81 }
82
83 sub process_table {
84   my @spec       =  split(/=/, shift, 2);
85   my $table      =  $spec[0];
86   my $schema     = '';
87   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
88   my $package    =  ucfirst($spec[1] || $spec[0]);
89   $package       =~ s/_+(.)/uc($1)/ge;
90   my $meta_file  =  "${meta_path}/${package}.pm";
91   my $file       =  "SL/DB/${package}.pm";
92
93   $schema        = <<CODE if $schema;
94     __PACKAGE__->meta->schema('$schema');
95 CODE
96
97   my $definition =  eval <<CODE;
98     package SL::DB::AUTO::$package;
99     use SL::DB::Object;
100     use base qw(SL::DB::Object);
101
102     __PACKAGE__->meta->table('$table');
103 $schema
104     __PACKAGE__->meta->auto_initialize;
105
106     __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'
107 CODE
108
109   if ($EVAL_ERROR) {
110     error("Error in execution for table '$table'");
111     error("'$EVAL_ERROR'") if $config{verbose};
112     return;
113   }
114
115   $definition =~ s/::AUTO::/::/g;
116
117   while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
118     $definition =~ s/( foreign_keys \s*=> \s*\[ .* ^\s+ ) ${auto_generated_name} \b/${1}${desired_name}/msx;
119   }
120
121   my $full_definition = <<CODE;
122 # This file has been auto-generated. Do not modify it; it will be overwritten
123 # by $::script automatically.
124 $definition;
125 CODE
126
127   my $meta_definition = <<CODE;
128 # This file has been auto-generated only because it didn't exist.
129 # Feel free to modify it at will; it will not be overwritten automatically.
130
131 package SL::DB::${package};
132
133 use strict;
134
135 use SL::DB::MetaSetup::${package};
136
137 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
138 __PACKAGE__->meta->make_manager_class;
139
140 1;
141 CODE
142
143   my $file_exists = -f $meta_file;
144   if ($file_exists) {
145     my $old_size    = -s $meta_file;
146     my $orig_file   = do { local(@ARGV, $/) = ($meta_file); <> };
147     my $old_md5     = md5_hex($orig_file);
148     my $new_size    = length $full_definition;
149     my $new_md5     = md5_hex($full_definition);
150     if ($old_size == $new_size && $old_md5 == $new_md5) {
151       notice("No changes in $meta_file, skipping.") if $config{verbose};
152       return;
153     }
154
155     show_diff(\$orig_file, \$full_definition) if $config{show_diff};
156   }
157
158   if (!$config{nocommit}) {
159     open my $out, ">", $meta_file || die;
160     print $out $full_definition;
161   }
162
163   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
164
165   if (! -f $file) {
166     if (!$config{nocommit}) {
167       open my $out, ">", $file || die;
168       print $out $meta_definition;
169     }
170
171     notice("File '$file' created as well.");
172   }
173 }
174
175 sub parse_args {
176   my ($options) = @_;
177   GetOptions(
178     'login|user=s'      => \ my $login,
179     all                 => \ my $all,
180     'no-commit|dry-run' => \ my $nocommit,
181     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
182     verbose             => \ my $verbose,
183     diff                => \ my $diff,
184   );
185
186   $options->{login}    = $login if $login;
187   $options->{all}      = $all;
188   $options->{nocommit} = $nocommit;
189   $options->{verbose}  = $verbose;
190
191   if ($diff) {
192     if (eval { require Text::Diff; 1 }) {
193       $options->{show_diff} = 1;
194     } else {
195       error('Could not load Text::Diff. Sorry, no diffs for you.');
196     }
197   }
198 }
199
200 sub show_diff {
201    my ($text_a, $text_b) = @_;
202
203    my %colors = (
204      '+' => 'green',
205      '-' => 'red',
206    );
207
208    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
209      for (split /\n/, $_[0]) {
210        print colored($_, $colors{substr($_, 0, 1)}), $/;
211      }
212    }});
213 }
214
215 sub usage {
216   pod2usage(verbose => 99, sections => 'SYNOPSIS');
217 }
218
219 sub make_tables {
220   my @tables;
221   if ($config{all}) {
222     my $db  = SL::DB::create(undef, 'LXOFFICE');
223     @tables =
224       map { $package_names{LXOFFICE}->{$_} ? "$_=" . $package_names{LXOFFICE}->{$_} : $_ }
225       grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{LXOFFICE} } }
226       $db->list_tables;
227   } elsif (@ARGV) {
228     @tables = @ARGV;
229   } else {
230     error("You specified neither --all nor any specific tables.");
231     usage();
232   }
233
234   @tables;
235 }
236
237 sub error {
238   print STDERR colored(shift, 'red'), $/;
239 }
240
241 sub notice {
242   print @_, $/;
243 }
244
245 parse_args(\%config);
246 setup();
247 my @tables = make_tables();
248
249 for my $table (@tables) {
250   # add default model name unless model name is given or no defaults exists
251   $table .= '=' . $package_names{LXOFFICE}->{lc $table} if $table !~ /=/ && $package_names{LXOFFICE}->{lc $table};
252
253   process_table($table);
254 }
255
256 1;
257
258 __END__
259
260 =encoding utf-8
261
262 =head1 NAME
263
264 rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
265
266 =head1 SYNOPSIS
267
268   scripts/rose_create_model.pl --login login table1[=package1] [table2[=package2] ...]
269   scripts/rose_create_model.pl --login login [--all|-a]
270
271   # updates all models
272   scripts/rose_create_model.pl --login login --all
273
274   # updates only customer table, login taken from config
275   scripts/rose_create_model.pl customer
276
277   # updates only parts table, package will be Part
278   scripts/rose_create_model.pl parts=Part
279
280   # try to update parts, but don't do it. tell what would happen in detail
281   scripts/rose_create_model.pl --no-commit --verbose parts
282
283 =head1 DESCRIPTION
284
285 Rose::DB::Object comes with a nice function named auto initialization with code
286 generation. The documentation of Rose describes it like this:
287
288 I<[...] auto-initializing metadata at runtime by querying the database has many
289 caveats. An alternate approach is to query the database for metadata just once,
290 and then generate the equivalent Perl code which can be pasted directly into
291 the class definition in place of the call to auto_initialize.>
292
293 I<Like the auto-initialization process itself, perl code generation has a
294 convenient wrapper method as well as separate methods for the individual parts.
295 All of the perl code generation methods begin with "perl_", and they support
296 some rudimentary code formatting options to help the code conform to you
297 preferred style. Examples can be found with the documentation for each perl_*
298 method.>
299
300 I<This hybrid approach to metadata population strikes a good balance between
301 upfront effort and ongoing maintenance. Auto-generating the Perl code for the
302 initial class definition saves a lot of tedious typing. From that point on,
303 manually correcting and maintaining the definition is a small price to pay for
304 the decreased start-up cost, the ability to use the class in the absence of a
305 database connection, and the piece of mind that comes from knowing that your
306 class is stable, and won't change behind your back in response to an "action at
307 a distance" (i.e., a database schema update).>
308
309 Unfortunately this reads easier than it is, since classes need to go into the
310 right package and directory, certain stuff needs to be adjusted and table names
311 need to be translated into their class names. This script will wrap all that
312 behind a few simple options.
313
314 In the most basic version, just give it a login and a table name, and it will
315 load the schema information for this table and create the appropriate class
316 files, or update them if already present.
317
318 Each table has two associated files. A C<SL::DB::MetaSetup::*> class, which is
319 a perl version of the schema definition, and a C<SL::DB::*> class file. The
320 first one will be updated if the schema changes, the second one will only be
321 created if it does not exist.
322
323 =head1 OPTIONS
324
325 =over 4
326
327 =item C<--login, -l LOGIN>
328
329 =item C<--user, -u LOGIN>
330
331 Provide a login. If not present the login is loaded from the config key
332 C<devel/login>. If that too is not found, an error is thrown.
333
334 =item C<--all, -a>
335
336 Process all tables from the database. Only those that are blacklistes in
337 L<SL::DB::Helper::Mappings> are excluded.
338
339 =item C<--no-commit, -n>
340
341 =item C<--dry-run>
342
343 Do not write back generated files. This will do everything as usual but not
344 actually modify any file.
345
346 =item C<--diff>
347
348 Displays diff for selected file, if file is present and newer file is
349 different. Beware, does not imply C<--no-commit>.
350
351 =item C<--help, -h>
352
353 Print this help.
354
355 =item C<--verbose, -v>
356
357 Prints extra information, such as skipped files that were not changed and
358 errors where the auto initialization failed.
359
360 =back
361
362 =head1 BUGS
363
364 None yet.
365
366 =head1 AUTHOR
367
368 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
369
370 =cut