view release on metacpan or  search on metacpan

lib/App/AutoCRUD/DataSource.pm  view on Meta::CPAN

#======================================================================
# METHODS
#======================================================================

sub config {
  my ($self, @path) = @_;
  return reach $self->config_data, @path;
}


sub descr {
  my ($self) = @_;
  return $self->config('descr');
}

sub prepare_for_request {
  my ($self, $req) = @_;

  # if schema is in single-schema mode, make sure it is connected to
  # the proper database
  my $schema = $self->schema;
  $schema->dbh($self->dbh) unless ref $schema;
}


sub primary_key {
  my ($self, $table) = @_;

  return $self->_meta_table($table)->primary_key;
}


sub colgroups {
  my ($self, $table) = @_;

  # if info already in cache, return it
  my $colgroups = $self->{colgroups}{$table};
  return $colgroups if $colgroups;

  # paths from this table
  my $meta_table = $self->_meta_table($table);
  my %paths      = $meta_table->path;

  # primary_key
  my @pk = $meta_table->primary_key;

  # get column info from database
  my $db_catalog = $self->config(qw/dbh db_catalog/);
  my $db_schema  = $self->config(qw/dbh db_schema/);
  my $sth        = $self->dbh->column_info($db_catalog, $db_schema,
                                           $table, undef);
  my $columns    = $sth->fetchall_hashref('COLUMN_NAME');

  # TMP HACK, Oracle-specific. Q: How to design a good abstraction for this ?
  $columns = $self->_columns_from_Oracle_synonym($db_schema, $table)
    if ! keys %$columns and $self->dbh->{Driver}{Name} eq 'Oracle';

  # mark primary keys
  $columns->{$_}{is_pk} = 1 foreach @pk;

  # attach paths (in alphabetic order) to relevant columns
  foreach my $path (map {$paths{$_}} sort keys %paths) {
    # name of column(s) from which this path starts
    my %path_on             = $path->on;
    my ($col_name, @others) = keys %path_on;

    # for the moment, don't handle assoc on multiple columns (TODO)
    next if @others;

    my $col = $columns->{$col_name} or next;
    my $path_subdata = { name        => $path->name,
                         to_table    => $path->to->db_from,
                         foreign_key => $path_on{$col_name} };
    push @{$col->{paths}}, $path_subdata;
  }

  # grouping: merge with column info from config
  $colgroups = clone $self->config(tables => $table => 'colgroups') || [];
  foreach my $group (@$colgroups) {
    my @columns;
    foreach my $column (@{$group->{columns}}) {
      my $col_name = $column->{name};
      my $db_col = delete $columns->{$col_name} or next;
      push @columns, {%$db_col, %$column};
    }
    $group->{columns} = \@columns;
  }

  # deal with remaining columns (present in database but unlisted in
  # config); sorted with primary keys first, then alphabetically.
  my $sort_pk = sub {   $columns->{$a}{is_pk} ? -1
                      : $columns->{$b}{is_pk} ?  1
                      :                         $a cmp $b};
  if (my @other_cols = sort $sort_pk keys %$columns) {
    # build colgroup
    push @$colgroups, {name    => 'Unclassified columns', 
                       columns => [ @{$columns}{@other_cols} ]};
  }

  # cache result and return
  $self->{colgroups}{$table} = $colgroups;
  return $colgroups;
}




sub _columns_from_Oracle_synonym {
  my ($self, $db_schema, $syn_name) = @_;

  my $dbh = $self->dbh;
  my $sql = "SELECT TABLE_OWNER, TABLE_NAME FROM ALL_SYNONYMS "
          . "WHERE OWNER=? AND SYNONYM_NAME=?";
  my ($owner, $table) = $dbh->selectrow_array($sql, {}, $db_schema, $syn_name)
    or return {};

  my $sth = $dbh->column_info(undef, $owner, $table, undef);
  return $sth->fetchall_hashref('COLUMN_NAME')
}