DBIx-DataModel

 view release on metacpan or  search on metacpan

lib/DBIx/DataModel/Meta/Association.pm  view on Meta::CPAN

use parent "DBIx::DataModel::Meta";
use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_method define_readonly_accessors/;
use DBIx::DataModel::Carp;
# use Carp::Clan qw(^(DBIx::DataModel|SQL::Abstract));



use Params::Validate qw/validate_with SCALAR ARRAYREF HASHREF OBJECT UNDEF/;
use List::MoreUtils  qw/pairwise/;
use Scalar::Util     qw/weaken dualvar looks_like_number/;
use Module::Load     qw/load/;
use POSIX            qw/LONG_MAX/;
use namespace::clean;


# specification for parameters to new()
my $association_spec = {
  schema => {type => OBJECT, isa  => "DBIx::DataModel::Meta::Schema"},
  A      => {type => HASHREF},
  B      => {type => HASHREF},

lib/DBIx/DataModel/Meta/Association.pm  view on Meta::CPAN

  # install methods from A to B and B to A, if role names are not empty
  $self->{A}{role} || $self->{B}{role}
    or croak "at least one side of the association must have a role name";
  $self->$install_method(qw/A B/) if $self->{B}{role};
  $self->$install_method(qw/B A/) if $self->{A}{role};

  # EXPERIMENTAL : no longer need association ends; all info is stored in Paths
  delete@{$self}{qw/A B/};

  # avoid circular reference
  weaken $self->{schema};

  return $self;
}


# accessor methods
define_readonly_accessors(__PACKAGE__, qw/schema name kind path_AB path_BA/);


#----------------------------------------------------------------------

lib/DBIx/DataModel/Meta/Path.pm  view on Meta::CPAN

package DBIx::DataModel::Meta::Path;
use strict;
use warnings;
use parent "DBIx::DataModel::Meta";
use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors/;
use DBIx::DataModel::Carp;

use Scalar::Util                 qw/looks_like_number weaken/;
use Params::Validate             qw/validate_with SCALAR HASHREF ARRAYREF OBJECT/;
use namespace::clean;

{no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}

my $path_spec = {
  name         => {type => SCALAR},
  from         => {isa  => 'DBIx::DataModel::Meta::Source::Table'},
  to           => {isa  => 'DBIx::DataModel::Meta::Source::Table'},
  on           => {type => HASHREF}, # join condition

lib/DBIx/DataModel/Meta/Path.pm  view on Meta::CPAN

  my $class = shift;

  # parse arguments and create $self
  my $self = validate_with(
    params      => \@_,
    spec        => $path_spec,
    allow_extra => 0,
   );

  my $path = $self->{name};
  weaken $self->{$_} for qw/from to association/;

  # add this path into the 'from' metaclass
  not $self->{from}{path}{$path}
    or croak "$self->{from}{class} already has a path '$path'";
  $self->{from}{path}{$path} = $self;

  # if this is a composition path, remember it in the 'components' array
  push @{$self->{from}{components}}, $path
    if $self->{association}{kind} eq 'Composition' && $self->{direction} eq 'AB';

lib/DBIx/DataModel/Meta/Source.pm  view on Meta::CPAN

package DBIx::DataModel::Meta::Source;
use strict;
use warnings;
use parent "DBIx::DataModel::Meta";
use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_class define_readonly_accessors
                                    define_abstract_methods/;
use DBIx::DataModel::Carp;

use Params::Validate qw/validate_with SCALAR ARRAYREF HASHREF OBJECT/;
use Scalar::Util     qw/weaken/;
use List::MoreUtils  qw/any/;

use namespace::clean;

#----------------------------------------------------------------------
# COMPILE-TIME METHODS
#----------------------------------------------------------------------

my %common_arg_spec = (
  schema          => {isa  => "DBIx::DataModel::Meta::Schema"},

lib/DBIx/DataModel/Meta/Source.pm  view on Meta::CPAN

  }

  # the name is the short class name (before prepending the schema)
  $self->{name} = $self->{class};

  # prepend schema name in class name, unless it already contains "::"
  $self->{class} =~ s/^/$self->{schema}{class}::/
    unless $self->{class} =~ /::/;

  # avoid circular references
  weaken $self->{schema};

  # instanciate the metaclass
  bless $self, $class;

  # build the list of parent classes
  my @isa = map {$_->{class}} @{$self->{parents}};
  if ($isa_slot) {
    my $parent_class = $self->{schema}{$isa_slot}[0];
    unshift @isa, $parent_class
      unless any {$_->isa($parent_class)} @isa;

lib/DBIx/DataModel/Meta/Type.pm  view on Meta::CPAN

package DBIx::DataModel::Meta::Type;
use strict;
use warnings;
use parent "DBIx::DataModel::Meta";
use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors does/;
use DBIx::DataModel::Carp;

use Scalar::Util         qw/weaken/;
use Params::Validate     qw/validate_with OBJECT SCALAR HASHREF/;
use namespace::clean;

{no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}

sub new {
  my $class = shift;

  # parse arguments and create $self
  my $self = validate_with(

lib/DBIx/DataModel/Meta/Type.pm  view on Meta::CPAN

    },
    allow_extra => 0,
   );

  while (my ($name, $body) = each %{$self->{handlers}}) {
    does($body, 'CODE')
      or croak "handler body for $name is not a code reference";
  }

  # avoid circular references
  weaken $self->{schema};

  bless $self, $class;
}


# accessor methods
define_readonly_accessors(__PACKAGE__, qw/schema name handlers/);


1;

lib/DBIx/DataModel/Statement.pm  view on Meta::CPAN

#----------------------------------------------------------------------
package DBIx::DataModel::Statement;
#----------------------------------------------------------------------
# see POD doc at end of file

use warnings;
use strict;
use List::MoreUtils  qw/firstval any/;
use Scalar::Util     qw/weaken dualvar/;
use POSIX            qw/LONG_MAX/;
use Clone            qw/clone/;
use DBIx::DataModel::Carp;
use Try::Tiny        qw/try catch/;
use mro              qw/c3/;

use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors does/;
use namespace::clean;

lib/DBIx/DataModel/Statement.pm  view on Meta::CPAN

  if (my $regex = $self->{placeholder_regex}) {
    for (my $i = 0; $i < @{$self->{bound_params}}; $i++) {
      $self->{bound_params}[$i] =~ $regex 
        and push @{$self->{param_indices}{$1}}, $i;
    }
  }
  $self->bind($self->{pre_bound_params}) if $self->{pre_bound_params};

  # compute callback to apply to data rows
  my $callback = $self->{args}{-post_bless};
  weaken(my $weak_self = $self);   # weaken to avoid a circular ref in closure
  $self->{row_callback} = sub {
    my $row = shift;
    $weak_self->bless_from_DB($row);
    $callback->($row) if $callback;
  };

  return $self;
}