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);
12 use English qw( -no_match_vars );
13 use List::MoreUtils qw(any);
21 use SL::DB::Helper::ALL;
22 use SL::DB::Helper::Mappings;
28 our $script = __FILE__;
31 $OUTPUT_AUTOFLUSH = 1;
32 $Data::Dumper::Sortkeys = 1;
34 our $meta_path = "SL/DB/MetaSetup";
38 print "Usage: $PROGRAM_NAME login table1[=package1] [table2[=package2] ...]\n";
39 print " or $PROGRAM_NAME login [--all|-a] [--sugar|-s]\n";
43 my $login = shift @ARGV;
45 $::userspath = "users";
46 $::templates = "templates";
47 $::sendmail = "| /usr/sbin/sendmail -t";
49 $::lxdebug = LXDebug->new();
51 require "config/lx-erp.conf";
52 require "config/lx-erp-local.conf" if -f "config/lx-erp-local.conf";
55 $::locale = Locale->new("de");
58 $::auth = SL::Auth->new();
60 $::user = User->new($login);
62 %::myconfig = $auth->read_user($login);
63 $form->{script} = 'rose_meta_data.pl';
64 $form->{login} = $login;
66 map { $form->{$_} = $::myconfig{$_} } qw(stylesheet charset);
68 mkdir $meta_path unless -d $meta_path;
72 my @spec = split(/=/, shift, 2);
75 ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
76 my $package = ucfirst($spec[1] || $spec[0]);
77 $package =~ s/_+(.)/uc($1)/ge;
78 my $meta_file = "${meta_path}/${package}.pm";
79 my $file = "SL/DB/${package}.pm";
81 $schema = <<CODE if $schema;
82 __PACKAGE__->meta->schema('$schema');
85 my $definition = eval <<CODE;
86 package SL::DB::AUTO::$package;
88 use base qw(SL::DB::Object);
90 __PACKAGE__->meta->table('$table');
92 __PACKAGE__->meta->auto_initialize;
94 __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'
98 print STDERR "Error in execution for table '$table': $EVAL_ERROR";
102 $definition =~ s/::AUTO::/::/g;
104 my $file_exists = -f $meta_file;
106 open(OUT, ">$meta_file") || die;
108 # This file has been auto-generated. Do not modify it; it will be overwritten
109 # by $::script automatically.
114 print "File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'\n";
117 open(OUT, ">$file") || die;
119 # This file has been auto-generated only because it didn't exist.
120 # Feel free to modify it at will; it will not be overwritten automatically.
122 package SL::DB::${package};
126 use SL::DB::MetaSetup::${package};
128 # Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
129 __PACKAGE__->meta->make_manager_class;
135 print "File '$file' created as well.\n";
141 my %blacklist = SL::DB::Helper::Mappings->get_blacklist;
142 my %package_names = SL::DB::Helper::Mappings->get_package_names;
145 if (($ARGV[0] eq '--all') || ($ARGV[0] eq '-a') || ($ARGV[0] eq '--sugar') || ($ARGV[0] eq '-s')) {
146 my ($type, $prefix) = ($ARGV[0] eq '--sugar') || ($ARGV[0] eq '-s') ? ('SUGAR', 'sugar_') : ('LXOFFICE', '');
147 my $db = SL::DB::create(undef, $type);
148 @tables = map { $package_names{$type}->{$_} ? "${_}=" . $package_names{$type}->{$_} : $prefix ? "${_}=${prefix}${_}" : $_ }
149 grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{$type} } }
156 foreach my $table (@tables) {
157 # add default model name unless model name is given or no defaults exists
158 $table .= '=' . $package_names{LXOFFICE}->{lc $table} if $table !~ /=/ && $package_names{LXOFFICE}->{lc $table};
160 process_table($table);