Globale Variablen nach %::lx_office_conf verschoben
[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 Data::Dumper;
12 use English qw( -no_match_vars );
13 use List::MoreUtils qw(any);
14
15 use SL::Auth;
16 use SL::DBUtils;
17 use SL::DB;
18 use SL::Form;
19 use SL::Locale;
20 use SL::LXDebug;
21 use SL::DB::Helper::ALL;
22 use SL::DB::Helper::Mappings;
23
24 our $form;
25 our $cgi;
26 our $auth;
27
28 our $script =  __FILE__;
29 $script     =~ s:.*/::;
30
31 $OUTPUT_AUTOFLUSH       = 1;
32 $Data::Dumper::Sortkeys = 1;
33
34 our $meta_path = "SL/DB/MetaSetup";
35
36 sub setup {
37   if (@ARGV < 2) {
38     print "Usage: $PROGRAM_NAME login table1[=package1] [table2[=package2] ...]\n";
39     print "   or  $PROGRAM_NAME login [--all|-a] [--sugar|-s]\n";
40     exit 1;
41   }
42
43   my $login     = shift @ARGV;
44
45   $::lxdebug    = LXDebug->new();
46
47   require "config/lx-erp.conf";
48   require "config/lx-erp-local.conf" if -f "config/lx-erp-local.conf";
49
50   # locale messages
51   $::locale       = Locale->new("de");
52   $::form         = new Form;
53   $::cgi          = new CGI('');
54   $::auth         = SL::Auth->new();
55
56   $::user         = User->new($login);
57
58   %::myconfig     = $auth->read_user($login);
59   $form->{script} = 'rose_meta_data.pl';
60   $form->{login}  = $login;
61
62   map { $form->{$_} = $::myconfig{$_} } qw(stylesheet charset);
63
64   mkdir $meta_path unless -d $meta_path;
65 }
66
67 sub process_table {
68   my @spec       =  split(/=/, shift, 2);
69   my $table      =  $spec[0];
70   my $schema     = '';
71   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
72   my $package    =  ucfirst($spec[1] || $spec[0]);
73   $package       =~ s/_+(.)/uc($1)/ge;
74   my $meta_file  =  "${meta_path}/${package}.pm";
75   my $file       =  "SL/DB/${package}.pm";
76
77   $schema        = <<CODE if $schema;
78     __PACKAGE__->meta->schema('$schema');
79 CODE
80
81   my $definition =  eval <<CODE;
82     package SL::DB::AUTO::$package;
83     use SL::DB::Object;
84     use base qw(SL::DB::Object);
85
86     __PACKAGE__->meta->table('$table');
87 $schema
88     __PACKAGE__->meta->auto_initialize;
89
90     __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'
91 CODE
92
93   if ($EVAL_ERROR) {
94     print STDERR "Error in execution for table '$table': $EVAL_ERROR";
95     return;
96   }
97
98   $definition =~ s/::AUTO::/::/g;
99
100   my $file_exists = -f $meta_file;
101
102   open(OUT, ">$meta_file") || die;
103   print OUT <<CODE;
104 # This file has been auto-generated. Do not modify it; it will be overwritten
105 # by $::script automatically.
106 $definition;
107 CODE
108   close OUT;
109
110   print "File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'\n";
111
112   if (! -f $file) {
113     open(OUT, ">$file") || die;
114     print OUT <<CODE;
115 # This file has been auto-generated only because it didn't exist.
116 # Feel free to modify it at will; it will not be overwritten automatically.
117
118 package SL::DB::${package};
119
120 use strict;
121
122 use SL::DB::MetaSetup::${package};
123
124 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
125 __PACKAGE__->meta->make_manager_class;
126
127 1;
128 CODE
129     close OUT;
130
131     print "File '$file' created as well.\n";
132   }
133 }
134
135 setup();
136
137 my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;
138 my %package_names = SL::DB::Helper::Mappings->get_package_names;
139
140 my @tables = ();
141 if (($ARGV[0] eq '--all') || ($ARGV[0] eq '-a') || ($ARGV[0] eq '--sugar') || ($ARGV[0] eq '-s')) {
142   my ($type, $prefix) = ($ARGV[0] eq '--sugar') || ($ARGV[0] eq '-s') ? ('SUGAR', 'sugar_') : ('LXOFFICE', '');
143   my $db              = SL::DB::create(undef, $type);
144   @tables             = map  { $package_names{$type}->{$_} ? "${_}=" . $package_names{$type}->{$_} : $prefix ? "${_}=${prefix}${_}" : $_ }
145                         grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{$type} } }
146                         $db->list_tables;
147
148 } else {
149   @tables = @ARGV;
150 }
151
152 foreach my $table (@tables) {
153   # add default model name unless model name is given or no defaults exists
154   $table .= '=' . $package_names{LXOFFICE}->{lc $table} if $table !~ /=/ && $package_names{LXOFFICE}->{lc $table};
155
156   process_table($table);
157 }