view release on metacpan or  search on metacpan

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

        #'-------------------------------------------------------------------------------',
        ('-' x 80),
        '  *** ' . $ddl->relative($home) . '  --  DO NOT MOVE OR RENAME THIS FILE ***','',
        "Add your DDL here (i.e. CREATE TABLE statements)",'',
        "To (re)initialize your SQLite database (" . $sqlt->relative($home) . ") and (re)generate",
        "your DBIC schema classes and update your base TableSpec configs, run this command",
        "from your app home directory:",'',
        "   perl devel/$updater_script_name --from-ddl --cfg",
        "\n" . ('-' x 80) . "\n" 
      );
      
      print "Initializing blank DDL file \"$ddl\"\n";
      $ddl->spew( $blank_content );
    }
    
    if (-f $sqlt) {
      # TODO: support the regenerate/rescan and/or -force cases...
      die "RapidDbic: error - will not overwrite existing file '$sqlt'\n" ;
      #print " exists \"$sqlt\"\n";
    }
    else {
      my $sqlite3 = can_run('sqlite3') or die 'sqlite3 not available!';
      
      print "Initializing blank SQLite database '" . $sqlt->relative . "'\n";
      print "\n-->> calling system command:  sqlite3 $sqlt \".databases\" ";
      
      my $result = run_forked([$sqlite3,$sqlt,'".databases"']);
      my $exit = $result->{exit_code};
      
      print " [exit: $exit]\n";
      die "\n" . $result->{err_msg} if ($exit);
      
      print "\n";
    }
    
    -f $sqlt or die "db file '$sqlt' wasn't created; an unknown error has occured.";

    # We are using the current, *absolute* path to the db file here on purpose. This 
    # will be dynamically converted to be a *runtime* relative path in the actual
    # model class which is created by our DBIC::Schema::ForRapidDbic model helper:
    @connect_info = ( join(':','dbi','SQLite',$sqlt->absolute->resolve->stringify) );
    
    $self->_ra_add_rapiddbic_extra_info(
      "NOTE: A blank DDL (i.e. native SQLite schema) has been setup at: $ddl",
      "now write your schema (i.e. CREATE TABLE statements) in this file and ",
      "generate your database and DBIC schema classes and update your base ",
      "TableSpec configs by calling this script from your app home dir:\n",
      "  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),
      "  -------------------------------",''