projekt kivitendo

use Digest::MD5 qw(md5_hex);

use Getopt::Long;

use Pod::Usage;

use Term::ANSIColor;

my %blacklist     = SL::DB::Helper::Mappings->get_blacklist;

my %package_names = SL::DB::Helper::Mappings->get_package_names;

my %config;

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

  if (!$login) {

    error("No login found in config. Please provide a login:");

    usage();

  }

  $::lxdebug    = LXDebug->new();

    error("Error in execution for table '$table'");

    error("'$EVAL_ERROR'") if $config{verbose};

  my $full_definition = <<CODE;

  my $meta_definition = <<CODE;

  my $file_exists = -f $meta_file;

  if ($file_exists) {

    my $old_size    = -s $meta_file;

    my $old_md5     = md5_hex(do { local(@ARGV, $/) = ($meta_file); <> });

    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};

      return;

    }

  }

  if (!$config{nocommit}) {

    open my $out, ">", $meta_file || die;

    print $out $full_definition;

  }

  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;

    }

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

sub parse_args {

  my ($options) = @_;

  GetOptions(

    'login|user=s'  => \ my $login,

    all             => \ my $all,

    sugar           => \ my $sugar,

    'no-commit'     => \ my $nocommit,

    help            => sub { pod2usage(verbose => 99, sections => 'NAME|SYNOPSIS|OPTIONS') },

    verbose         => \ my $verbose,

  );

  $options->{login}    = $login if $login;

  $options->{sugar}    = $sugar;

  $options->{all}      = $all;

  $options->{nocommit} = $nocommit;

  $options->{verbose}  = $verbose;

}

sub usage {

  pod2usage(verbose => 99, sections => 'SYNOPSIS');

}

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;

  } elsif (@ARGV) {

    @tables = @ARGV;

  } else {

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

    usage();

  }

  @tables;

sub error {

  print STDERR colored(shift, 'red'), $/;

}

sub notice {

  print @_, $/;

}

parse_args(\%config);

setup();

my @tables = make_tables();

for my $table (@tables) {

1;

__END__

=encoding utf-8

=head1 NAME

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

=head1 SYNOPSIS

  scripts/rose_create_model.pl --login login table1[=package1] [table2[=package2] ...]

  scripts/rose_create_model.pl --login login [--all|-a] [--sugar|-s]

  # updates all models

  scripts/rose_create_model.pl --login login --all

  # updates only customer table, login taken from config

  scripts/rose_create_model.pl customer

  # updates only parts table, package will be Part

  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

=head1 DESCRIPTION

Rose::DB::Object comes with a nice function named auto initialization with code

generation. The documentation of Rose describes it like this:

I<[...] auto-initializing metadata at runtime by querying the database has many

caveats. An alternate approach is to query the database for metadata just once,

and then generate the equivalent Perl code which can be pasted directly into

the class definition in place of the call to auto_initialize.>

I<Like the auto-initialization process itself, perl code generation has a

convenient wrapper method as well as separate methods for the individual parts.

All of the perl code generation methods begin with "perl_", and they support

some rudimentary code formatting options to help the code conform to you

preferred style. Examples can be found with the documentation for each perl_*

method.>

I<This hybrid approach to metadata population strikes a good balance between

upfront effort and ongoing maintenance. Auto-generating the Perl code for the

initial class definition saves a lot of tedious typing. From that point on,

manually correcting and maintaining the definition is a small price to pay for

the decreased start-up cost, the ability to use the class in the absence of a

database connection, and the piece of mind that comes from knowing that your

class is stable, and won't change behind your back in response to an "action at

a distance" (i.e., a database schema update).>

Unfortunately this ready easier than it is, since classes need to get in the

right package and directory, certain stuff need to be adjusted and table names

need to be translated into their class names. This script will wrap all that

behind a few simple options.

In the most basic version, just give it a login and

=head1 OPTIONS

=over 4

=item C<--login, -l LOGIN>

=item C<--user, -u LOGIN>

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.

=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>

Do not write back generated files. This will do everything as usual but not

actually modify any files.

=item C<--help, -h>

Print this help.

=item C<--verbose, -v>

Prints extra information, such as skipped files that were not changed and

errors where the auto initialization failed.

=back

=head1 BUGS

None yet.

=head1 AUTHOR

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

=cut