ActiveRecord-Simple
view release on metacpan or search on metacpan
lib/ActiveRecord/Simple.pm view on Meta::CPAN
load_module $related_class;
my $rel_type = undef;
while (my ($rel_key, $rel_opts) = each %{ $related_class->_get_relations }) {
next if $class ne _get_related_class($rel_opts);
$rel_type = $rel_opts->{type};
}
croak 'Oops! Looks like related class ' . $related_class . ' has no relations with ' . $class unless $rel_type;
$type .= $rel_type;
return $type;
}
sub _get_related_subclass {
my ($relation) = @_;
return undef if !ref $relation->{class};
my $subclass;
if (ref $relation->{class} eq 'HASH') {
$subclass = (keys %{ $relation->{class} })[0];
}
elsif (ref $relation->{class} eq 'ARRAY') {
$subclass = $relation->{class}[0];
}
return $subclass;
}
sub _get_related_class {
my ($relation) = @_;
return $relation->{class} if !ref $relation->{class};
my $related_class;
if (ref $relation->{class} eq 'HASH') {
$related_class = ( %{ $relation->{class} } )[1]
}
elsif (ref $relation->{class} eq 'ARRAY') {
$related_class = $relation->{class}[1];
}
return $related_class;
}
sub _insert {
my ($self, $param) = @_;
return unless $self->dbh && $param;
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = grep { defined $param->{$_} } sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my $field_names_str = join q/, /, map { q/"/ . $_ . q/"/ } @field_names;
my (@bind, @values_list);
for (@field_names) {
if (ref $param->{$_} eq 'SCALAR') {
push @values_list, ${ $param->{$_} };
}
else {
push @values_list, '?';
push @bind, $param->{$_};
}
}
my $values = join q/, /, @values_list;
my $pkey_val;
my $sql_stm = qq{
INSERT INTO "$table_name" ($field_names_str)
VALUES ($values)
};
if ( $self->dbh->{Driver}{Name} eq 'Pg' ) {
if ($primary_key) {
$sql_stm .= ' RETURINIG ' . $primary_key if $primary_key;
$sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name});
$pkey_val = $self->dbh->selectrow_array($sql_stm, undef, @bind);
}
else {
my $sth = $self->dbh->prepare(
ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
);
$sth->execute(@bind);
}
}
else {
my $sth = $self->dbh->prepare(
ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
);
$sth->execute(@bind);
if ( $primary_key && defined $self->{$primary_key} ) {
$pkey_val = $self->{$primary_key};
}
else {
$pkey_val =
exists $sth->{mysql_insertid} # mysql only
? $sth->{mysql_insertid}
: $self->dbh->last_insert_id(undef, undef, $table_name, undef);
}
}
if (defined $primary_key && $self->can($primary_key) && $pkey_val) {
#$self->$primary_key($pkey_val);
$self->{$primary_key} = $pkey_val;
}
$self->{isin_database} = 1;
return $pkey_val;
}
sub _update {
my ($self, $param) = @_;
return unless $self->dbh && $param;
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my (@set_list, @bind);
for (@field_names) {
if (ref $param->{$_} eq 'SCALAR') {
push @set_list, $_ . ' = ' . ${ $param->{$_} };
}
else {
push @set_list, "$_ = ?";
push @bind, $param->{$_};
}
}
my $setstring = join q/, /, @set_list;
push @bind, $self->{$primary_key};
my $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt(
qq{
UPDATE "$table_name" SET $setstring
WHERE
$primary_key = ?
},
$self->dbh->{Driver}{Name}
);
return $self->dbh->do($sql_stm, undef, @bind);
}
sub _mk_rw_accessors {
my ($class, $fields) = @_;
return unless $fields;
return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
$class->_mk_accessors($fields, 'rw');
}
sub _mk_ro_accessors {
my ($class, $fields) = @_;
return unless $fields;
return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
$class->_mk_accessors($fields, 'ro');
}
sub _mk_accessors {
my ($class, $fields, $type) = @_;
$type ||= 'rw';
my $code_string = q//;
METHOD_NAME:
for my $method_name (@$fields) {
next METHOD_NAME if $class->can($method_name);
$code_string .= "sub $method_name {\n";
if ($type eq 'rw') {
$code_string .= "if (\@_ > 1) { \$_[0]->{$method_name} = \$_[1]; return \$_[0] }\n";
}
elsif ($type eq 'ro') {
$code_string .= "die 'Object is read-only, sorry' if \@_ > 1;\n";
}
$code_string .= "return \$_[0]->{$method_name};\n }\n";
}
eval "package $class;\n $code_string" if $code_string;
say $@ if $@;
}
sub _guess {
my ($what_key, $class) = @_;
return 'id' if $what_key eq 'primary_key';
#eval { load $class }; ### TODO: check class has been loaded
#load $class unless is_loaded $class;
#mark_as_loaded $class;
load_module $class;
my $table_name = _what_is_the_table_name($class);
$table_name =~ s/s$// if $what_key eq 'foreign_key';
( run in 0.870 second using v1.01-cache-2.11-cpan-2398b32b56e )