X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=scripts%2Frose_auto_create_model.pl;h=2ab34cb90d38b3db92463d2d5426a798ffa995a0;hb=abafb475d9742e3a6c28427477235c923b21eeef;hp=8106576a84b3e69342d69f24acd58a3c5d9b189e;hpb=fa7fc7eeb3ca718914affee06c0629a08d571288;p=kivitendo-erp.git diff --git a/scripts/rose_auto_create_model.pl b/scripts/rose_auto_create_model.pl index 8106576a8..2ab34cb90 100755 --- a/scripts/rose_auto_create_model.pl +++ b/scripts/rose_auto_create_model.pl @@ -3,8 +3,10 @@ use strict; BEGIN { - unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. } use CGI qw( -no_xhtml); @@ -13,7 +15,7 @@ use Data::Dumper; use Digest::MD5 qw(md5_hex); use English qw( -no_match_vars ); use Getopt::Long; -use List::MoreUtils qw(none); +use List::MoreUtils qw(apply none uniq); use List::UtilsBy qw(partition_by); use Pod::Usage; use Rose::DB::Object 0.809; @@ -23,12 +25,15 @@ use SL::Auth; use SL::DBUtils; use SL::DB; use SL::Form; +use SL::InstanceConfiguration; use SL::Locale; use SL::LXDebug; use SL::LxOfficeConf; use SL::DB::Helper::ALL; use SL::DB::Helper::Mappings; +chdir($FindBin::Bin . '/..'); + my %blacklist = SL::DB::Helper::Mappings->get_blacklist; my %package_names = SL::DB::Helper::Mappings->get_package_names; @@ -37,7 +42,7 @@ our $auth; our %lx_office_conf; our $script = __FILE__; -$script =~ s:.*/::; +$script =~ s{.*/}{}; $OUTPUT_AUTOFLUSH = 1; $Data::Dumper::Sortkeys = 1; @@ -69,10 +74,16 @@ our %foreign_key_name_map = ( orderitems => { parts_id => 'part', trans_id => 'order', }, delivery_order_items => { parts_id => 'part' }, invoice => { parts_id => 'part' }, - follow_ups => { created_for_user => 'created_for', created_by => 'created_by', }, + follow_ups => { created_for_user => 'created_for_employee', created_by => 'created_by_employee', }, follow_up_access => { who => 'with_access', what => 'to_follow_ups_by', }, - periodic_invoices_configs => { oe_id => 'order' }, + periodic_invoices_configs => { oe_id => 'order', email_recipient_contact_id => 'email_recipient_contact' }, + reconciliation_links => { acc_trans_id => 'acc_trans' }, + + assembly => { parts_id => 'part', id => 'assembly_part' }, + assortment_items => { parts_id => 'part' }, + + dunning => { trans_id => 'invoice', fee_interest_ar_id => 'fee_interest_invoice' }, }, ); @@ -80,18 +91,28 @@ sub setup { SL::LxOfficeConf->read; - my $client = $config{client} || $::lx_office_conf{devel}{client}; + my $client = $config{client} || $::lx_office_conf{devel}{client}; + my $new_client = $config{new_client}; - if (!$client) { + if (!$client && !$new_client) { error("No client found in config. Please provide a client:"); usage(); } - $::lxdebug = LXDebug->new(); - $::locale = Locale->new("de"); - $::form = new Form; - $form->{script} = 'rose_meta_data.pl'; - $::auth = SL::Auth->new(); + $::lxdebug = LXDebug->new(); + $::lxdebug->disable_sub_tracing; + $::locale = Locale->new("de"); + $::form = new Form; + $::instance_conf = SL::InstanceConfiguration->new; + $form->{script} = 'rose_meta_data.pl'; + + if ($new_client) { + $::auth = SL::Auth->new(unit_tests_database => 1); + $client = 1; + drop_and_create_test_database(); + } else { + $::auth = SL::Auth->new(); + } if (!$::auth->set_client($client)) { error("No client with ID or name '$client' found in config. Please provide a client:"); @@ -136,8 +157,7 @@ CODE eval <meta->table('$table'); $schema_str @@ -196,6 +216,7 @@ CODE } $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema; + $definition =~ s{^use base}{use parent}m; my $full_definition = < \ my $client, + 'test-client' => \ my $use_test_client, all => \ my $all, 'db=s' => \ my $db, 'no-commit|dry-run' => \ my $nocommit, @@ -288,12 +309,13 @@ sub parse_args { diff => \ my $diff, ); - $options->{client} = $client; - $options->{all} = $all; - $options->{db} = $db; - $options->{nocommit} = $nocommit; - $options->{quiet} = $quiet; - $options->{color} = -t STDOUT ? 1 : 0; + $options->{client} = $client; + $options->{new_client} = $use_test_client; + $options->{all} = $all; + $options->{db} = $db; + $options->{nocommit} = $nocommit; + $options->{quiet} = $quiet; + $options->{color} = -t STDOUT ? 1 : 0; if ($diff) { if (eval { require Text::Diff; 1 }) { @@ -327,6 +349,22 @@ sub usage { pod2usage(verbose => 99, sections => 'SYNOPSIS'); } +sub list_all_tables { + my ($db) = @_; + + my @schemas = (undef, uniq apply { s{\..*}{} } grep { m{\.} } keys %{ $package_names{KIVITENDO} }); + my @tables; + + foreach my $schema (@schemas) { + $db->schema($schema); + push @tables, map { $schema ? "${schema}.${_}" : $_ } $db->list_tables; + } + + $db->schema(undef); + + return @tables; +} + sub make_tables { my %tables_by_domain; if ($config{all}) { @@ -334,7 +372,7 @@ sub make_tables { foreach my $domain (@domains) { my $db = SL::DB::create(undef, $domain); - $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } $db->list_tables ]; + $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } list_all_tables($db) ]; $db->disconnect; } @@ -374,6 +412,149 @@ sub check_errors_in_package_names { } } +sub drop_and_create_test_database { + my $db_cfg = $::lx_office_conf{'testing/database'} || die 'testing/database missing'; + + my @dbi_options = ( + 'dbi:Pg:dbname=' . $db_cfg->{template} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port}, + $db_cfg->{user}, + $db_cfg->{password}, + SL::DBConnect->get_options, + ); + + $::auth->reset; + my $dbh_template = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("No database connection to the template database: " . $DBI::errstr); + my $auth_dbh = $::auth->dbconnect(1); + + if ($auth_dbh) { + notice("Database exists; dropping"); + $auth_dbh->disconnect; + + dbh_do($dbh_template, "DROP DATABASE \"" . $db_cfg->{db} . "\"", message => "Database could not be dropped"); + } + + notice("Creating database"); + + dbh_do($dbh_template, "CREATE DATABASE \"" . $db_cfg->{db} . "\" TEMPLATE \"" . $db_cfg->{template} . "\" ENCODING 'UNICODE'", message => "Database could not be created"); + $dbh_template->disconnect; + + notice("Creating initial schema"); + + @dbi_options = ( + 'dbi:Pg:dbname=' . $db_cfg->{db} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port}, + $db_cfg->{user}, + $db_cfg->{password}, + SL::DBConnect->get_options(PrintError => 0, PrintWarn => 0), + ); + + my $dbh = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("Database connection failed: " . $DBI::errstr); + $::auth->{dbh} = $dbh; + my $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, silent => 1); + my $coa = 'Germany-DATEV-SKR03EU'; + + apply_dbupgrade($dbupdater, $dbh, "sql/lx-office.sql"); + apply_dbupgrade($dbupdater, $dbh, "sql/${coa}-chart.sql"); + + dbh_do($dbh, qq|UPDATE defaults SET coa = '${coa}', accounting_method = 'cash', profit_determination = 'income', inventory_system = 'periodic', curr = 'EUR'|); + dbh_do($dbh, qq|CREATE TABLE schema_info (tag TEXT, login TEXT, itime TIMESTAMP DEFAULT now(), PRIMARY KEY (tag))|); + + notice("Creating initial auth schema"); + + $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => 1); + apply_dbupgrade($dbupdater, $dbh, 'sql/auth_db.sql'); + + apply_upgrades(auth => 1, dbh => $dbh); + + $::auth->reset; + + notice("Creating client, user, group and employee"); + + dbh_do($dbh, qq|DELETE FROM auth.clients|); + dbh_do($dbh, qq|INSERT INTO auth.clients (id, name, dbhost, dbport, dbname, dbuser, dbpasswd, is_default) VALUES (1, 'Unit-Tests', ?, ?, ?, ?, ?, TRUE)|, + bind => [ @{ $db_cfg }{ qw(host port db user password) } ]); + dbh_do($dbh, qq|INSERT INTO auth."user" (id, login) VALUES (1, 'unittests')|); + dbh_do($dbh, qq|INSERT INTO auth."group" (id, name) VALUES (1, 'Vollzugriff')|); + dbh_do($dbh, qq|INSERT INTO auth.clients_users (client_id, user_id) VALUES (1, 1)|); + dbh_do($dbh, qq|INSERT INTO auth.clients_groups (client_id, group_id) VALUES (1, 1)|); + dbh_do($dbh, qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (1, 1)|); + + my %config = ( + default_printer_id => '', + template_format => '', + default_media => '', + email => 'unit@tester', + tel => '', + dateformat => 'dd.mm.yy', + show_form_details => '', + name => 'Unit Tester', + signature => '', + hide_cvar_search_options => '', + numberformat => '1.000,00', + favorites => '', + copies => '', + menustyle => 'v3', + fax => '', + stylesheet => 'lx-office-erp.css', + mandatory_departments => 0, + countrycode => 'de', + ); + + my $sth = $dbh->prepare(qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (1, ?, ?)|) || BAIL_OUT($dbh->errstr); + dbh_do($dbh, $sth, bind => [ $_, $config{$_} ]) for sort keys %config; + $sth->finish; + + $sth = $dbh->prepare(qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (1, ?, TRUE)|) || BAIL_OUT($dbh->errstr); + dbh_do($dbh, $sth, bind => [ $_ ]) for sort $::auth->all_rights; + $sth->finish; + + dbh_do($dbh, qq|INSERT INTO employee (id, login, name) VALUES (1, 'unittests', 'Unit Tester')|); + + $::auth->set_client(1) || BAIL_OUT("\$::auth->set_client(1) failed"); + %::myconfig = $::auth->read_user(login => 'unittests'); + + apply_upgrades(dbh => $dbh); +} + +sub apply_upgrades { + my %params = @_; + my $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => $params{auth}); + my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($params{dbh}); + + my $all = @unapplied_scripts; + my $i; + for my $script (@unapplied_scripts) { + ++$i; + print "\rUpgrade $i/$all"; + apply_dbupgrade($dbupdater, $params{dbh}, $script); + } + print " - done.\n"; +} + +sub apply_dbupgrade { + my ($dbupdater, $dbh, $control_or_file) = @_; + + my $file = ref($control_or_file) ? ("sql/Pg-upgrade2" . ($dbupdater->{auth} ? "-auth" : "") . "/$control_or_file->{file}") : $control_or_file; + my $control = ref($control_or_file) ? $control_or_file : undef; + + my $error = $dbupdater->process_file($dbh, $file, $control); + + die("Error applying $file: $error") if $error; +} + +sub dbh_do { + my ($dbh, $query, %params) = @_; + + if (ref($query)) { + return if $query->execute(@{ $params{bind} || [] }); + die($dbh->errstr); + } + + return if $dbh->do($query, undef, @{ $params{bind} || [] }); + + die($params{message} . ": " . $dbh->errstr) if $params{message}; + die("Query failed: " . $dbh->errstr . " ; query: $query"); +} + parse_args(\%config); setup(); check_errors_in_package_names(); @@ -403,11 +584,15 @@ rose_auto_create_model - mana Rose::DB::Object classes for kivitendo =head1 SYNOPSIS - scripts/rose_auto_create_model.pl --client name-or-id [db1:]table1 [[db2:]table2 ...] - scripts/rose_auto_create_model.pl --client name-or-id [--all|-a] + scripts/rose_auto_create_model.pl OPTIONS TARGET + + # use other client than devel.client + scripts/rose_auto_create_model.pl --test-client TARGET + scripts/rose_auto_create_model.pl --client name-or-id TARGET + # TARGETS: # updates all models - scripts/rose_auto_create_model.pl --client name-or-id --all [--db db] + scripts/rose_auto_create_model.pl --all [--db db] # updates only customer table, login taken from config scripts/rose_auto_create_model.pl customer @@ -474,13 +659,21 @@ L. =over 4 +=item C<--test-client, -t> + +Use the C to create a new testing database, and connect to +the first client there. Overrides C. + +If neither C nor C are set, the config key C +will be used. + =item C<--client, -c CLIENT> -Provide a client whose database settings are used. If not present the -client is loaded from the config key C. If that too is -not found, an error is thrown. +Provide a client whose database settings are used. C can be either a +database ID or a client's name. -Note that C can be either a database ID or a client's name. +If neither C nor C are set, the config key C +will be used. =item C<--all, -a>