Merge branch 'master' of github.com:kivitendo/kivitendo-erp

[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 12ac0bd..bb246f8 100755 (executable)
--- a/scripts/rose_auto_create_model.pl
+++ b/scripts/rose_auto_create_model.pl
@@ -13,7 +13,7 @@ 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 Pod::Usage;
 use Term::ANSIColor;
 
 use Pod::Usage;
 use Term::ANSIColor;
 


@@ -40,69 +40,122 @@ $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;
 

+our %foreign_key_name_map = (
+  oe                   => { payment => 'payment_terms', },
+  ar                   => { payment => 'payment_terms', },
+  ap                   => { payment => 'payment_terms', },
+
+  orderitems           => { parts => 'part', trans => 'order', },
+  delivery_order_items => { parts => 'part' },
+  invoice              => { parts => 'part' },
+  follow_ups           => { 'employee_obj' => 'created_for' },
+
+  periodic_invoices_configs => { oe => 'order' },
+);
+

 sub setup {
 
   SL::LxOfficeConf->read;
 
 sub setup {
 
   SL::LxOfficeConf->read;
 

-  my $login     = $config{login} || $::lx_office_conf{devel}{login};
+  my $client = $config{client} || $::lx_office_conf{devel}{client};

 
 

-  if (!$login) {
-    error("No login found in config. Please provide a login:");
+  if (!$client) {
+    error("No client found in config. Please provide a client:");

     usage();
   }
 
   $::lxdebug      = LXDebug->new();
   $::locale       = Locale->new("de");
   $::form         = new Form;
     usage();
   }
 
   $::lxdebug      = LXDebug->new();
   $::locale       = Locale->new("de");
   $::form         = new Form;

-  $::auth         = SL::Auth->new();
-  $::user         = User->new($login);
-  %::myconfig     = $auth->read_user($login);
-  $::request      = { cgi => CGI->new({}) };

   $form->{script} = 'rose_meta_data.pl';
   $form->{script} = 'rose_meta_data.pl';

-  $form->{login}  = $login;
+  $::auth         = SL::Auth->new();

 
 

-  map { $form->{$_} = $::myconfig{$_} } qw(stylesheet charset);
+  if (!$::auth->set_client($client)) {
+    error("No client with ID or name '$client' found in config. Please provide a client:");
+    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 @spec       =  @_;

   my $table      =  $spec[0];
   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
   my $package    =  ucfirst($spec[1] || $spec[0]);
   $package       =~ s/_+(.)/uc($1)/ge;
   my $meta_file  =  "${meta_path}/${package}.pm";
   my $table      =  $spec[0];
   my $schema     = '';
   ($schema, $table) = split(m/\./, $table) if $table =~ m/\./;
   my $package    =  ucfirst($spec[1] || $spec[0]);
   $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 $file       =  "SL/DB/${package}.pm";
 

-  $schema        = <<CODE if $schema;
-    __PACKAGE__->meta->schema('$schema');
+  my $schema_str = $schema ? <<CODE : '';
+__PACKAGE__->meta->schema('$schema');

 CODE
 
 CODE
 

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

     package SL::DB::AUTO::$package;
     use SL::DB::Object;
     use base qw(SL::DB::Object);
 
     __PACKAGE__->meta->table('$table');
     package SL::DB::AUTO::$package;
     use SL::DB::Object;
     use base qw(SL::DB::Object);
 
     __PACKAGE__->meta->table('$table');

-$schema
+    $schema_str

     __PACKAGE__->meta->auto_initialize;
 
     __PACKAGE__->meta->auto_initialize;
 

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

 CODE
 
   if ($EVAL_ERROR) {
     error("Error in execution for table '$table'");
 CODE
 
   if ($EVAL_ERROR) {
     error("Error in execution for table '$table'");

-    error("'$EVAL_ERROR'") if $config{verbose};
+    error("'$EVAL_ERROR'") unless $config{quiet};

     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;

+
+
+  # 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/(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
 # by $::script automatically.
   my $full_definition = <<CODE;
 # This file has been auto-generated. Do not modify it; it will be overwritten
 # by $::script automatically.


@@ -118,9 +171,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


@@ -133,7 +186,7 @@ CODE
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);
     if ($old_size == $new_size && $old_md5 == $new_md5) {
     my $new_size    = length $full_definition;
     my $new_md5     = md5_hex($full_definition);
     if ($old_size == $new_size && $old_md5 == $new_md5) {

-      notice("No changes in $meta_file, skipping.") if $config{verbose};
+      notice("No changes in $meta_file, skipping.") unless $config{quiet};

       return;
     }
 
       return;
     }
 


@@ -147,33 +200,57 @@ 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;

 
 

-    notice("File '$file' created as well.");
+  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;
+
+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 {
   my ($options) = @_;
   GetOptions(
 }
 
 sub parse_args {
   my ($options) = @_;
   GetOptions(

-    'login|user=s'      => \ my $login,
+    'client=s'          => \ my $client,

     all                 => \ my $all,
     all                 => \ my $all,

-    sugar               => \ my $sugar,

     'no-commit|dry-run' => \ my $nocommit,
     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },
     'no-commit|dry-run' => \ my $nocommit,
     help                => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },

-    verbose             => \ my $verbose,
+    quiet               => \ my $quiet,

     diff                => \ my $diff,
   );
 
     diff                => \ my $diff,
   );
 

-  $options->{login}    = $login if $login;
-  $options->{sugar}    = $sugar;
+  $options->{client}   = $client;

   $options->{all}      = $all;
   $options->{nocommit} = $nocommit;
   $options->{all}      = $all;
   $options->{nocommit} = $nocommit;

-  $options->{verbose}  = $verbose;
+  $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 }) {


@@ -194,7 +271,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 $_, $/;
+       }

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


@@ -205,17 +286,14 @@ sub usage {
 
 sub make_tables {
   my @tables;
 
 sub make_tables {
   my @tables;

-  if ($config{all} || $config{sugar}) {
-    my ($type, $prefix) = $config{sugar} ? ('SUGAR', 'sugar_') : ('LXOFFICE', '');
-    my $db              = SL::DB::create(undef, $type);
-    @tables             =
-      map { $package_names{$type}->{$_} ? "$_=" . $package_names{$type}->{$_} : $prefix ? "$_=$prefix$_" : $_ }
-      grep { my $table = $_; !any { $_ eq $table } @{ $blacklist{$type} } }
-      $db->list_tables;
+  if ($config{all}) {
+    my $db  = SL::DB::create(undef, 'KIVITENDO');
+    @tables = grep { my $table = $_; none { $_ eq $table } @{ $blacklist{KIVITENDO} } } $db->list_tables;
+

   } elsif (@ARGV) {
     @tables = @ARGV;
   } else {
   } elsif (@ARGV) {
     @tables = @ARGV;
   } else {

-    error("You specified neither --sugar nor --all nor any specific tables.");
+    error("You specified neither --all nor any specific tables.");

     usage();
   }
 
     usage();
   }
 


@@ -234,13 +312,14 @@ parse_args(\%config);
 setup();
 my @tables = make_tables();
 
 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{LXOFFICE}->{lc $table} if $table !~ /=/ && $package_names{LXOFFICE}->{lc $table};
-
-  process_table($table);
+my @unknown_tables = grep { !$package_names{KIVITENDO}->{$_} } @tables;
+if (@unknown_tables) {
+  error("The following tables do not have entries in \%SL::DB::Helper::Mappings::kivitendo_package_names: " . join(' ', sort @unknown_tables));
+  exit 1;

 }
 
 }
 

+process_table($_, $package_names{KIVITENDO}->{$_}) for @tables;
+

 1;
 
 __END__
 1;
 
 __END__


@@ -249,15 +328,15 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 

-rose_auto_create_model - mana Rose::DB::Object classes for Lx-Office
+rose_auto_create_model - mana Rose::DB::Object classes for kivitendo

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-  scripts/rose_create_model.pl --login login table1[=package1] [table2[=package2] ...]
-  scripts/rose_create_model.pl --login login [--all|-a] [--sugar|-s]
+  scripts/rose_create_model.pl --client name-or-id table1 [table2 ...]
+  scripts/rose_create_model.pl --client name-or-id [--all|-a]

 
   # updates all models
 
   # updates all models

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

 
   # updates only customer table, login taken from config
   scripts/rose_create_model.pl customer
 
   # updates only customer table, login taken from config
   scripts/rose_create_model.pl customer


@@ -266,7 +345,7 @@ rose_auto_create_model - mana Rose::DB::Object classes for Lx-Office
   scripts/rose_create_model.pl parts=Part
 
   # try to update parts, but don't do it. tell what would happen in detail
   scripts/rose_create_model.pl parts=Part
 
   # try to update parts, but don't do it. tell what would happen in detail

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

 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 


@@ -303,33 +382,31 @@ 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 OPTIONS
 
 =over 4
 
 
 =head1 OPTIONS
 
 =over 4
 

-=item C<--login, -l LOGIN>
+=item C<--client, -c CLIENT>

 
 

-=item C<--user, -u LOGIN>
+Provide a client whose database settings are used. If not present the
+client is loaded from the config key C<devel/client>. If that too is
+not found, an error is thrown.

 
 

-Provide a login. If not present the login is loaded from the config key
-C<devel/login>. If that too is not found, an error is thrown.
+Note that C<CLIENT> can be either a database ID or a client's name.

 
 =item C<--all, -a>
 
 Process all tables from the database. Only those that are blacklistes in
 L<SL::DB::Helper::Mappings> are excluded.
 
 
 =item C<--all, -a>
 
 Process all tables from the database. Only those that are blacklistes in
 L<SL::DB::Helper::Mappings> are excluded.
 

-=item C<--sugar, -s>
-
-Process tables in sugar schema instead of standard schema. Rarely useful unless
-you debug schema awareness of the RDBO layer.
-

 =item C<--no-commit, -n>
 =item C<--no-commit, -n>

+

 =item C<--dry-run>
 
 Do not write back generated files. This will do everything as usual but not
 =item C<--dry-run>
 
 Do not write back generated files. This will do everything as usual but not


@@ -344,10 +421,10 @@ different. Beware, does not imply C<--no-commit>.
 
 Print this help.
 
 
 Print this help.
 

-=item C<--verbose, -v>
+=item C<--quiet, -q>

 
 

-Prints extra information, such as skipped files that were not changed and
-errors where the auto initialization failed.
+Does not print extra information, such as skipped files that were not
+changed and errors where the auto initialization failed.

 
 =back
 
 
 =back
 


@@ -357,6 +434,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