Locale::format_date_object: explizites Setzen der Formate; Millisekunden als neues...

[kivitendo-erp.git] / scripts / rose_auto_create_model.pl

diff --git a/scripts/rose_auto_create_model.pl b/scripts/rose_auto_create_model.pl
index d2b6886..14fea79 100755 (executable)
--- a/scripts/rose_auto_create_model.pl
+++ b/scripts/rose_auto_create_model.pl
@@ -13,8 +13,10 @@ use Data::Dumper;
 use Digest::MD5 qw(md5_hex);
 use English qw( -no_match_vars );
 use Getopt::Long;
 use Digest::MD5 qw(md5_hex);
 use English qw( -no_match_vars );
 use Getopt::Long;

-use List::MoreUtils qw(any);
+use List::MoreUtils qw(none);
+use List::UtilsBy qw(partition_by);

 use Pod::Usage;
 use Pod::Usage;

+use Rose::DB::Object 0.809;

 use Term::ANSIColor;
 
 use SL::Auth;
 use Term::ANSIColor;
 
 use SL::Auth;


@@ -40,7 +42,8 @@ $script     =~ s:.*/::;
 $OUTPUT_AUTOFLUSH       = 1;
 $Data::Dumper::Sortkeys = 1;
 
 $OUTPUT_AUTOFLUSH       = 1;
 $Data::Dumper::Sortkeys = 1;
 

-our $meta_path = "SL/DB/MetaSetup";
+our $meta_path    = "SL/DB/MetaSetup";
+our $manager_path = "SL/DB/Manager";

 
 my %config;
 
 
 my %config;
 


@@ -52,6 +55,7 @@ our %foreign_key_name_map = (
   orderitems           => { parts => 'part', trans => 'order', },
   delivery_order_items => { parts => 'part' },
   invoice              => { parts => 'part' },
   orderitems           => { parts => 'part', trans => 'order', },
   delivery_order_items => { parts => 'part' },
   invoice              => { parts => 'part' },

+  follow_ups           => { 'employee_obj' => 'created_for' },

 
   periodic_invoices_configs => { oe => 'order' },
 );
 
   periodic_invoices_configs => { oe => 'order' },
 );


@@ -78,24 +82,26 @@ sub setup {
     usage();
   }
 
     usage();
   }
 

-  mkdir $meta_path unless -d $meta_path;
+  foreach (($meta_path, $manager_path)) {
+    mkdir $_ unless -d;
+  }

 }
 
 sub process_table {
 }
 
 sub process_table {

-  my @spec       =  split(/=/, shift, 2);
-  my $table      =  $spec[0];
+  my ($domain, $table, $package) = @_;

   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;

-  my $package    =  ucfirst($spec[1] || $spec[0]);
+  $package       =  ucfirst($package || $table);

   $package       =~ s/_+(.)/uc($1)/ge;
   my $meta_file  =  "${meta_path}/${package}.pm";
   $package       =~ s/_+(.)/uc($1)/ge;
   my $meta_file  =  "${meta_path}/${package}.pm";

+  my $mngr_file  =  "${manager_path}/${package}.pm";

   my $file       =  "SL/DB/${package}.pm";
 
   my $schema_str = $schema ? <<CODE : '';
 __PACKAGE__->meta->schema('$schema');
 CODE
 
   my $file       =  "SL/DB/${package}.pm";
 
   my $schema_str = $schema ? <<CODE : '';
 __PACKAGE__->meta->schema('$schema');
 CODE
 

-  my $definition =  eval <<CODE;
+  eval <<CODE;

     package SL::DB::AUTO::$package;
     use SL::DB::Object;
     use base qw(SL::DB::Object);
     package SL::DB::AUTO::$package;
     use SL::DB::Object;
     use base qw(SL::DB::Object);


@@ -104,7 +110,6 @@ CODE
     $schema_str
     __PACKAGE__->meta->auto_initialize;
 
     $schema_str
     __PACKAGE__->meta->auto_initialize;
 

-    __PACKAGE__->meta->perl_class_definition(indent => 2); # , braces => 'bsd'

 CODE
 
   if ($EVAL_ERROR) {
 CODE
 
   if ($EVAL_ERROR) {


@@ -113,13 +118,44 @@ CODE
     return;
   }
 
     return;
   }
 

+  my %args = (indent => 2, use_setup => 0);
+
+  my $definition =  "SL::DB::AUTO::$package"->meta->perl_class_definition(%args);
+  $definition =~ s/\n+__PACKAGE__->meta->initialize;\n+/\n\n/;

   $definition =~ s/::AUTO::/::/g;
 
   $definition =~ s/::AUTO::/::/g;
 

-  while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
-    $definition =~ s/( foreign_keys \s*=> \s*\[ .* ^\s+ ) ${auto_generated_name} \b/${1}${desired_name}/msx;
+
+  # Sort column definitions alphabetically
+  if ($definition =~ m/__PACKAGE__->meta->columns\( \n (.+?) \n \);/msx) {
+    my ($start, $end)  = ($-[1], $+[1]);
+    my $sorted_columns = join "\n", sort split m/\n/, $1;
+    substr $definition, $start, $end - $start, $sorted_columns;
+  }
+
+  # patch foreign keys
+  my $foreign_key_definition = "SL::DB::AUTO::$package"->meta->perl_foreign_keys_definition(%args);
+  $foreign_key_definition =~ s/::AUTO::/::/g;
+
+  if ($foreign_key_definition && ($definition =~ /\Q$foreign_key_definition\E/)) {
+    my ($start, $end) = ($-[0], $+[0]);
+
+    while (my ($auto_generated_name, $desired_name) = each %{ $foreign_key_name_map{$table} || {} }) {
+      $foreign_key_definition =~ s/^ \s \s ${auto_generated_name} \b/  ${desired_name}/msx;
+    }
+
+    # Sort foreign key definitions alphabetically
+    if ($foreign_key_definition =~ m/\(\n(.+)\n\)/s) {
+      my ($list_start, $list_end) = ($-[0], $+[0]);
+      my @foreign_keys            = split m/\n\n/m, $1;
+      my $sorted_foreign_keys     = "(\n" . join("\n\n", sort @foreign_keys) . "\n)";
+
+      substr $foreign_key_definition, $list_start, $list_end - $list_start, $sorted_foreign_keys;;
+    }
+
+    substr($definition, $start, $end - $start) = $foreign_key_definition;

   }
 
   }
 

-  $definition =~ s/(table\s*=>.*?\n)/$1  schema  => '${schema}',\n/ if $schema;
+  $definition =~ s/(meta->table.*)\n/$1\n$schema_str/m if $schema;

 
   my $full_definition = <<CODE;
 # This file has been auto-generated. Do not modify it; it will be overwritten
 
   my $full_definition = <<CODE;
 # This file has been auto-generated. Do not modify it; it will be overwritten


@@ -136,9 +172,9 @@ package SL::DB::${package};
 use strict;
 
 use SL::DB::MetaSetup::${package};
 use strict;
 
 use SL::DB::MetaSetup::${package};

+use SL::DB::Manager::${package};

 
 

-# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
-__PACKAGE__->meta->make_manager_class;
+__PACKAGE__->meta->initialize;

 
 1;
 CODE
 
 1;
 CODE


@@ -150,7 +186,7 @@ CODE
     my $old_md5     = md5_hex($orig_file);
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);
     my $old_md5     = md5_hex($orig_file);
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);

-    if ($old_size == $new_size && $old_md5 == $new_md5) {
+    if ($old_size == $new_size && $old_md5 eq $new_md5) {

       notice("No changes in $meta_file, skipping.") unless $config{quiet};
       return;
     }
       notice("No changes in $meta_file, skipping.") unless $config{quiet};
       return;
     }


@@ -165,14 +201,39 @@ CODE
 
   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 
 
   notice("File '$meta_file' " . ($file_exists ? 'updated' : 'created') . " for table '$table'");
 

-  if (! -f $file) {
-    if (!$config{nocommit}) {
-      open my $out, ">", $file || die;
-      print $out $meta_definition;
-    }
+  return if -f $file;
+
+  if (!$config{nocommit}) {
+    open my $out, ">", $file || die;
+    print $out $meta_definition;
+  }
+
+  notice("File '$file' created as well.");
+
+  return if -f $mngr_file;
+
+  if (!$config{nocommit}) {
+    open my $out, ">", $mngr_file || die;
+    print $out <<EOT;
+# This file has been auto-generated only because it didn't exist.
+# Feel free to modify it at will; it will not be overwritten automatically.
+
+package SL::DB::Manager::${package};
+
+use strict;

 
 

-    notice("File '$file' created as well.");
+use SL::DB::Helper::Manager;
+use base qw(SL::DB::Helper::Manager);
+
+sub object_class { 'SL::DB::${package}' }
+
+__PACKAGE__->make_manager_methods;
+
+1;
+EOT

   }
   }

+
+  notice("File '$mngr_file' created as well.");

 }
 
 sub parse_args {
 }
 
 sub parse_args {


@@ -190,6 +251,7 @@ sub parse_args {
   $options->{all}      = $all;
   $options->{nocommit} = $nocommit;
   $options->{quiet}    = $quiet;
   $options->{all}      = $all;
   $options->{nocommit} = $nocommit;
   $options->{quiet}    = $quiet;

+  $options->{color}    = -t STDOUT ? 1 : 0;

 
   if ($diff) {
     if (eval { require Text::Diff; 1 }) {
 
   if ($diff) {
     if (eval { require Text::Diff; 1 }) {


@@ -210,7 +272,11 @@ sub show_diff {
 
    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
      for (split /\n/, $_[0]) {
 
    Text::Diff::diff($text_a, $text_b, { OUTPUT => sub {
      for (split /\n/, $_[0]) {

-       print colored($_, $colors{substr($_, 0, 1)}), $/;
+       if ($config{color}) {
+         print colored($_, $colors{substr($_, 0, 1)}), $/;
+       } else {
+         print $_, $/;
+       }

      }
    }});
 }
      }
    }});
 }


@@ -220,21 +286,30 @@ sub usage {
 }
 
 sub make_tables {
 }
 
 sub make_tables {

-  my @tables;
+  my %tables_by_domain;

   if ($config{all}) {
   if ($config{all}) {

-    my $db  = SL::DB::create(undef, 'KIVITENDO');
-    @tables =
-      map { $package_names{KIVITENDO}->{$_} ? "$_=" . $package_names{KIVITENDO}->{$_} : $_ }
-      grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{KIVITENDO} } }
-      $db->list_tables;
+    foreach my $domain (sort keys %package_names) {
+      my $db  = SL::DB::create(undef, $domain);
+      $tables_by_domain{$domain} = [ grep { my $table = $_; none { $_ eq $table } @{ $blacklist{$domain} } } $db->list_tables ];
+      $db->disconnect;
+    }
+

   } elsif (@ARGV) {
   } elsif (@ARGV) {

-    @tables = @ARGV;
+    %tables_by_domain = partition_by {
+      my ($domain, $table) = split m{:};
+      $table ? uc($domain) : 'KIVITENDO';
+    } @ARGV;
+
+    foreach my $tables (values %tables_by_domain) {
+      s{.*:}{} for @{ $tables };
+    }
+

   } else {
     error("You specified neither --all nor any specific tables.");
     usage();
   }
 
   } else {
     error("You specified neither --all nor any specific tables.");
     usage();
   }
 

-  @tables;
+  return %tables_by_domain;

 }
 
 sub error {
 }
 
 sub error {


@@ -247,13 +322,18 @@ sub notice {
 
 parse_args(\%config);
 setup();
 
 parse_args(\%config);
 setup();

-my @tables = make_tables();

 
 

-for my $table (@tables) {
-  # add default model name unless model name is given or no defaults exists
-  $table .= '=' . $package_names{KIVITENDO}->{lc $table} if $table !~ /=/ && $package_names{KIVITENDO}->{lc $table};
+my %tables_by_domain = make_tables();

 
 

-  process_table($table);
+foreach my $domain (keys %tables_by_domain) {
+  my @tables         = @{ $tables_by_domain{$domain} };
+  my @unknown_tables = grep { !$package_names{$domain}->{$_} } @tables;
+  if (@unknown_tables) {
+    error("The following tables do not have entries in \%SL::DB::Helper::Mappings::${domain}_package_names: " . join(' ', sort @unknown_tables));
+    exit 1;
+  }
+
+  process_table($domain, $_, $package_names{$domain}->{$_}) for @tables;

 }
 
 1;
 }
 
 1;


@@ -268,20 +348,20 @@ rose_auto_create_model - mana Rose::DB::Object classes for kivitendo
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-  scripts/rose_create_model.pl --client name-or-id table1[=package1] [table2[=package2] ...]
-  scripts/rose_create_model.pl --client name-or-id [--all|-a]
+  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]

 
   # updates all models
 
   # updates all models

-  scripts/rose_create_model.pl --client name-or-id --all
+  scripts/rose_auto_create_model.pl --client name-or-id --all

 
   # updates only customer table, login taken from config
 
   # updates only customer table, login taken from config

-  scripts/rose_create_model.pl customer
+  scripts/rose_auto_create_model.pl customer

 
   # updates only parts table, package will be Part
 
   # updates only parts table, package will be Part

-  scripts/rose_create_model.pl parts=Part
+  scripts/rose_auto_create_model.pl parts=Part

 
   # try to update parts, but don't do it. tell what would happen in detail
 
   # try to update parts, but don't do it. tell what would happen in detail

-  scripts/rose_create_model.pl --no-commit parts
+  scripts/rose_auto_create_model.pl --no-commit parts

 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 


@@ -318,10 +398,22 @@ In the most basic version, just give it a login and a table name, and it will
 load the schema information for this table and create the appropriate class
 files, or update them if already present.
 
 load the schema information for this table and create the appropriate class
 files, or update them if already present.
 

-Each table has two associated files. A C<SL::DB::MetaSetup::*> class, which is
-a perl version of the schema definition, and a C<SL::DB::*> class file. The
-first one will be updated if the schema changes, the second one will only be
-created if it does not exist.
+Each table has three associated files. A C<SL::DB::MetaSetup::*>
+class, which is a perl version of the schema definition, a
+C<SL::DB::*> class file and a C<SL::DB::Manager::*> manager class
+file. The first one will be updated if the schema changes, the second
+and third ones will only be created if it they do not exist.
+
+=head1 DATABASE NAMES AND TABLES
+
+If you want to generate the data for specific tables only then you
+have to list them on the command line. The format is
+C<db-name:table-name>. The part C<db-name:> is optional and defaults
+to C<KIVITENDO:> – which means the tables in the default kivitendo
+database.
+
+Valid database names are keys in the hash returned by
+L<SL::DB::Helper::Mappings/get_package_names>.

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 


@@ -369,6 +461,7 @@ None yet.
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 

+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,

 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 
 =cut
 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 
 =cut