view release on metacpan or  search on metacpan

lib/DBIO/Cake.pm  view on Meta::CPAN

@EXPORT = (
  @col_types, @col_modifiers,
  @table_funcs, @relationship_funcs,
  @cascade_funcs, @other_funcs,
);

# Per-caller options storage
my %CALLER_OPTS;

sub import {
  my ($class, @args) = @_;
  my $caller = caller;

  # Parse import options
  my %opts = (
    autoclean => 1,
    inflate_datetime => 0,
    inflate_json => 0,
    inflate_jsonb => 0,
    retrieve_defaults => 0,
  );

  my @components;
  my $storage_class = 'DBIO::Storage::DBI';

  while (my $arg = shift @args) {
    if ($arg eq '-V2') {
      # default and only version, no-op
    }
    elsif ($arg =~ /^-(\w+)$/ && _resolve_driver_defaults($1)) {
      # Driver shortcut: -Pg, -MySQL, -SQLite etc.
      # Uses the DBIO::Storage::DBI driver registry to find the storage class,
      # calls cake_defaults() on it to get driver-recommended options.
      $storage_class = _resolve_driver_defaults($1);
      my %driver_opts = $storage_class->cake_defaults;
      @opts{keys %driver_opts} = values %driver_opts;
    }
    elsif ($arg eq '-inflate_datetime') {
      $opts{inflate_datetime} = 1;
    }
    elsif ($arg eq '-inflate_json') {
      $opts{inflate_json} = 1;
    }
    elsif ($arg eq '-inflate_jsonb') {
      $opts{inflate_jsonb} = 1;
    }
    elsif ($arg eq '-retrieve_defaults') {
      $opts{retrieve_defaults} = 1;
    }
    elsif ($arg eq '-autoclean') {
      $opts{autoclean} = 1;
    }
    elsif ($arg eq '-no_autoclean') {
      $opts{autoclean} = 0;
    }
  }

  $opts{_storage_class} = $storage_class;

  # Enable strict and warnings in caller
  strict->import;
  warnings->import;

  # Set up inheritance -- caller ISA DBIO::Core
  {
    no strict 'refs';
    unless ($caller->isa('DBIO::Core')) {
      require DBIO::Core;
      push @{"${caller}::ISA"}, 'DBIO::Core';
    }
  }

  # Always load Timestamp for col_created/col_updated/cols_updated_created
  push @components, 'Timestamp';

  # Collect components from the type registry based on active options
  my %seen_components;
  require DBIO::Storage::DBI;
  for my $type_name ($storage_class->all_type_names) {
    my $info = $storage_class->type_info($type_name) or next;
    for my $opt (@{ $info->{cake_options} || [] }) {
      if ($opts{$opt}) {
        $seen_components{$_}++ for @{ $info->{components} || [] };
        last;
      }
    }
  }
  push @components, keys %seen_components;

  $caller->load_components(@components);

  # Store per-caller options
  $CALLER_OPTS{$caller} = \%opts;

  # Export all DSL functions into the caller
  {
    no strict 'refs';
    for my $func (@EXPORT) {
      *{"${caller}::${func}"} = \&{$func};
    }
  }

  # Schedule namespace cleanup at end of caller's scope
  if ($opts{autoclean}) {
    require namespace::clean;
    namespace::clean->import(
      -cleanee => $caller,
      @EXPORT,
    );
  }
}

# --- Internal helpers ---

sub _resolve_driver_defaults {
  my ($driver_name) = @_;

  # Look up the storage class from the DBIO::Storage::DBI driver registry
  require DBIO::Storage::DBI;
  my $storage_class = DBIO::Storage::DBI->driver_storage_class($driver_name)
    or return;