DBIO

 view release on metacpan or  search on metacpan

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

package DBIO::Cake;
# ABSTRACT: DDL-like DSL for defining DBIO result classes

use strict;
use warnings;
use Scalar::Util ();

our @EXPORT;
our %EXPORT_TAGS;

my @col_types = qw(
  integer tinyint smallint bigint
  serial bigserial smallserial
  numeric decimal
  real float4 double float8 float
  char varchar
  text tinytext mediumtext longtext
  blob tinyblob mediumblob longblob bytea
  boolean bool
  date datetime timestamp time timetz timestamptz interval
  enum set uuid json jsonb xml hstore
  array
  money
  vector halfvec sparsevec bit varbit
  inet cidr macaddr macaddr8
  tsvector tsquery
  point line lseg box path polygon circle
  int4range int8range numrange tsrange tstzrange daterange
);

my @col_modifiers = qw(
  null auto_inc fk default unsigned on_create on_update
);

my @table_funcs = qw(
  table col primary_key unique
);

my @relationship_funcs = qw(
  belongs_to has_one has_many might_have many_to_many
  rel_one rel_many
);

my @cascade_funcs = qw(
  ddl_cascade dbic_cascade
);

my @other_funcs = qw(
  view idx
  col_created col_updated cols_updated_created
);

@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

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

    # unique $name => \@cols
    $class->add_unique_constraint($args[0] => $args[1]);
  }
  else {
    # Pass through
    $class->add_unique_constraint(@args);
  }
}

# --- Relationships ---

sub belongs_to {
  my ($name, $related, @rest) = @_;
  my $class = _caller_class();
  $class->belongs_to($name, $related, @rest);
}

sub has_one {
  my ($name, $related, @rest) = @_;
  my $class = _caller_class();
  $class->has_one($name, $related, @rest);
}

sub has_many {
  my ($name, $related, @rest) = @_;
  my $class = _caller_class();
  $class->has_many($name, $related, @rest);
}

sub might_have {
  my ($name, $related, @rest) = @_;
  my $class = _caller_class();
  $class->might_have($name, $related, @rest);
}

sub many_to_many {
  my ($name, $link, $foreign, @rest) = @_;
  my $class = _caller_class();
  $class->many_to_many($name, $link, $foreign, @rest);
}

# rel_one: belongs_to with LEFT JOIN (nullable FK convenience)
sub rel_one {
  my ($name, $related, $cond, @rest) = @_;
  my $class = _caller_class();
  my %attrs;
  %attrs = %{pop @rest} if @rest && ref $rest[-1] eq 'HASH';
  $attrs{join_type} = 'left';
  $class->belongs_to($name, $related, $cond, \%attrs);
}

# rel_many: has_many (already LEFT JOIN by default, but explicit)
sub rel_many {
  my ($name, $related, @rest) = @_;
  my $class = _caller_class();
  $class->has_many($name, $related, @rest);
}

# --- Cascade helpers ---

sub ddl_cascade {
  return (
    on_delete => 'CASCADE',
    on_update => 'CASCADE',
  );
}

sub dbic_cascade {
  return (
    cascade_delete => 1,
    cascade_copy   => 1,
  );
}

# --- Views ---

sub view {
  my ($name, $sql, %opts) = @_;
  my $class = _caller_class();

  $class->table_class('DBIO::ResultSource::View')
    unless $class->table_class->isa('DBIO::ResultSource::View');

  require DBIO::ResultSource::View;
  $class->table($name);
  $class->result_source_instance->view_definition($sql);

  if ($opts{depends_on}) {
    $class->result_source_instance->deploy_depends_on(
      ref $opts{depends_on} ? $opts{depends_on} : [$opts{depends_on}]
    );
  }
}

# --- Indexes ---

sub idx {
  my ($name, $fields, %options) = @_;
  my $class = _caller_class();

  my $source = $class->result_source_instance;
  my $indexes = $source->{_cake_indexes} ||= [];
  push @$indexes, {
    name   => $name,
    fields => $fields,
    %options,
  };

  $class->_install_index_hooks($source);
}

# --- Timestamp column helpers ---

sub col_created {
  my $name = shift || 'created_at';
  col($name, timestamp, @_);
}

sub col_updated {
  my $name = shift || 'updated_at';
  col($name, timestamp, on_update, @_);
}

sub cols_updated_created {
  col_created(@_);
  col_updated(@_);
}

1;

__END__

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

  col count => integer unsigned;

=head2 default($value)

Sets the default value.

  col active => boolean default(1);
  col created => timestamp default(\"now()");

=head2 on_create

Explicitly set C<set_on_create>. Normally not needed -- NOT NULL timestamp
columns get this automatically.

=head2 on_update

Set C<set_on_update> -- the column value is refreshed on every row update.

  col updated_at => timestamp on_update;

=head1 TABLE AND CONSTRAINT FUNCTIONS

=head2 table

  table 'my_table';

Sets the table name for this result class.

=head2 primary_key

  primary_key 'id';
  primary_key 'artist_id', 'cd_id';

Sets the primary key column(s).

=head2 unique

  unique \@cols;
  unique $name => \@cols;

Adds a unique constraint.

=head1 RELATIONSHIP FUNCTIONS

  belongs_to author => 'MyApp::Schema::Result::Author', 'author_id';
  has_one    isbn   => 'MyApp::Schema::Result::ISBN', 'book_id';
  has_many   books  => 'MyApp::Schema::Result::Book', 'author_id';
  might_have bio    => 'MyApp::Schema::Result::Bio', 'author_id';
  many_to_many roles => 'actor_roles', 'role';

=head2 rel_one

Like C<belongs_to> but forces C<join_type =E<gt> 'left'>.

=head2 rel_many

Alias for C<has_many>.

=head1 CASCADE HELPERS

=head2 ddl_cascade

Returns C<on_delete =E<gt> 'CASCADE', on_update =E<gt> 'CASCADE'> for use in
relationship attribute hashes.

=head2 dbic_cascade

Returns C<cascade_delete =E<gt> 1, cascade_copy =E<gt> 1>.

=head1 VIEW SUPPORT

=head2 view

  view 'my_view', 'SELECT * FROM artists WHERE active = 1';

Declares a view-based result source.

=head1 TIMESTAMP HELPERS

Shortcut functions for the most common timestamp column patterns.

=head2 col_created

  col_created;               # creates 'created_at' column
  col_created 'born_at';     # custom column name

Equivalent to C<col created_at =E<gt> timestamp>.

=head2 col_updated

  col_updated;               # creates 'updated_at' column
  col_updated 'modified_at'; # custom column name

Equivalent to C<col updated_at =E<gt> timestamp on_update>.

=head2 cols_updated_created

  cols_updated_created;      # creates both created_at + updated_at

Creates both timestamp columns in one call. The most common pattern --
just add this one line and you're done.

=head1 INDEX SUPPORT

=head2 idx

  idx name_idx => ['name'];
  idx composite_idx => ['last_name', 'first_name'], type => 'unique';
  idx tags_idx => ['tags'], using => 'gin';
  idx draft_only => ['key'],
      type => 'unique',
      pg   => { where => 'version IS NULL' };

Declares an index. Cake installs two hooks on the Result class so that
C<idx> works transparently in both deployment pipelines:

=over

=item * C<sqlt_deploy_hook> — B<DEPRECATED> hook for legacy
deployment. The C<options> key passes producer-specific options through.

=item * C<pg_indexes> — used by L<DBIO::PostgreSQL::DDL> when the schema
loads the C<PostgreSQL> component. The C<pg> key carries
PostgreSQL-specific options (C<where>, C<using>, C<with>, C<expression>)
and is passed through to the native PG DDL emitter.

=back