view release on metacpan or  search on metacpan

lib/RapidApp/Helper/Traits/RapidDbic.pm  view on Meta::CPAN

      "  perl devel/$updater_script_name --from-ddl --cfg\n",
      "(you can run this script over and over to regenerate at any time)"
    );
  }
  
  
  my $connect_opt_defaults = [];
  if($connect_info[0] && $connect_info[0] =~ /^dbi\:SQLite\:/) {
    # Turn on unicode and forein keys for SQLite:
    $connect_opt_defaults = [qw/sqlite_unicode=1 on_connect_call=use_foreign_keys/];
  }
  elsif($connect_info[0] && $connect_info[0] =~ /^dbi\:mysql\:/) {
    # Turn on unicode and auto-reconnect for MySQL:
    $connect_opt_defaults = [qw/mysql_enable_utf8=1 mysql_auto_reconnect=1/];
  }
  # TODO: add default opts for pgsql, etc
  #...
  
  unshift @$connect_opt_defaults, 'quote_names=1';
  
  my @connect_opts = $self->_normalize_option_list(
    $opts->{'connect-option'} || [],
    $connect_opt_defaults
  );
  
  my $loader_opt_defaults = [qw/create=static generate_pod=0 preserve_case=1/];
  
  # -- GitHub Issue #164 --
  # turn on qualify_objects by default whenever a 'db-schema' is supplied:
  push @$loader_opt_defaults, 'qualify_objects=1' if (
    List::Util::first { $_ =~ /^db[-_]schema\=/ } @{$opts->{'loader-option'} || []}
  );
  # --
  
  my @loader_opts = $self->_normalize_option_list(
    $opts->{'loader-option'} || [],
    $loader_opt_defaults
  );
  
  die "create=static is the only allowed value for loader-option 'create'" if (
    List::Util::first { $_ =~ /^create\=/ && $_ ne 'create=static' } @loader_opts
  );
  
  my $schema_class = $opts->{'schema-class'} or die "missing required opt 'schema-class'";
  
  $opts->{grid_class} = join('::',$name,'Module','GridBase');
  
  try {
    # If this succeeds we are dealing with an existing schema - clear loader opts
    Module::Runtime::require_module($schema_class);
    @loader_opts = ();
  };

  my @args = (
    'model'                      => $opts->{'model-name'},
    'DBIC::Schema::ForRapidDbic' => $schema_class,
    @loader_opts, @connect_info, @connect_opts
  );
  
  {
    local @ARGV = @args;
    
    # This is ugly but is the cleanest way to pass in extra configs without mucking with
    # the complex arg call structure of the public/legacy API (of Model::DBIC::Schema)
    local $RapidApp::Helper::Traits::RapidDbic::_ra_rapiddbic_opts = $opts;
    print join("\n",
      'Generating DBIC schema/model using create script argument list:',
      "  -------------------------------",
      "  model $opts->{'model-name'}",
      "  DBIC::Schema::ForRapidDbic $opts->{'schema-class'}",
      (map { "     $_" } @loader_opts), 
      "  " . join(' ',@connect_info),
      (map { "     $_" } @connect_opts),
      "  -------------------------------",''
    );
    Catalyst::ScriptRunner->run($name => 'Create');
  }
  
  
  # New: create regen_schema.pl devel script:
  
  my $tpl = file(RapidApp->share_dir,qw(devel bootstrap model_NAME_updater.pl.tt));
  confess "Error: template file '$tpl' not found" unless (-f $tpl);
  
  my $contents = $tpl->slurp(iomode =>  "<:raw");
  my $vars = $self->_ra_appclass_tt_vars;
  $vars->{model_class} = join('::',$self->{name},'Model',$opts->{'model-name'});

  $vars->{from_ddl} = $ddl->relative($home) if ($ddl);
  $vars->{updater_script_name} = $updater_script_name;
  $self->render_file_contents($contents,file($self->{ra_devel},$updater_script_name),$vars);
  
  
  $tpl = file(RapidApp->share_dir,qw(devel bootstrap GridBase.pm.tt));
  confess "Error: template file '$tpl' not found" unless (-f $tpl);
  $contents = $tpl->slurp(iomode =>  "<:raw");
  
  my $grid_path = "$opts->{grid_class}.pm";
  $grid_path =~ s/::/\//g;
  my $grid_file = file($self->{dir},'lib',$grid_path);
  $grid_file->parent->mkpath(1) unless (-d $grid_file->parent);
  
  $self->render_file_contents($contents,$grid_file,$opts);
  
}

# take a list of option=value options with optional defaults and prune to unique
# option, with later values taking priority, and changing '-' to '_' in option name
sub _normalize_option_list {
  my $self = shift;
  my $opts = shift;
  my $defs = shift || [];
  
  my @order = ();
  my %o = ();
  
  map {
    my ($k,$v) = split(/\=/,$_,2);
    $k =~ s/\-/\_/g;
    push @order, $k unless (exists $o{$k});
    $o{$k} = $v;