view release on metacpan or  search on metacpan

lib/App/Repository.pm  view on Meta::CPAN

sub new_object {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $cols, $row, $options) = @_;

    my $table_def = $self->get_table_def($table);

    my $ref = ref($cols);
    my ($object);
    if ($ref && $ref eq "ARRAY") {
        $object = {};
        for (my $i = 0; $i <= $#$cols; $i++) {
            $object->{$cols->[$i]} = $row->[$i];
        }
    }
    elsif ($ref) {
        $object = { %$cols };
    }
    elsif ($cols) {
        $object = { $cols => $row };
    }
    else {
        $object = {};
    }

    my $class = $table_def->{class} || "App::RepositoryObject";
    # if $class is an ARRAY ref, we need to examine the qualifier(s) to determine the class
    $class = $self->_get_qualified_class($class, $object) if (ref($class));
    App->use($class);
    bless $object, $class;
    $object->_init();
    $self->_check_default_and_required_fields($object);

    if (!$options->{temp}) {
        my $retval = $self->insert_row($table, $object, undef, $options);
        die "new($table) unable to create a new row" if (!$retval);
        my $params = $self->_last_inserted_id();
        if (!$params) {
            $params = {};
            foreach my $col (keys %$object) {
                $params->{$col . ".eq"} = $object->{$col};
            }
        }
        $object = $self->get_object($table, $params, undef, $options);
    }

    &App::sub_exit($object) if ($App::trace);
    $object;
}

sub _check_default_and_required_fields {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $hash) = @_;
    my $table_def = $self->get_table_def($table);
    my $column_defs = $table_def->{column};
    if ($column_defs) {
        foreach my $column (keys %$column_defs) {
            if (!defined $hash->{$column}) {
                if (defined $column_defs->{$column}{default}) {
                    $hash->{$column} = $column_defs->{$column}{default};
                }
                elsif (defined $column_defs->{$column}{not_null}) {
                    die "Illegal object value for $table: $column cannot be NULL (i.e. undef)";
                }
            }
        }
    }
    my $primary_key = $table_def->{primary_key};
    if ($primary_key) {
        # Watch out for auto-generated primary keys. It's OK for them to be NULL.
        #if ($#$primary_key > 0) {
        #    foreach my $column (@$primary_key) {
        #        if (!defined $hash->{$column}) {
        #            die "Illegal object value for $table: $column cannot be NULL because it exists in the primary key";
        #        }
        #    }
        #}
    }
    my $alternate_keys = $table_def->{alternate_key};
    if ($alternate_keys) {
        foreach my $alternate_key (@$alternate_keys) {
            foreach my $column (@$alternate_key) {
                if (!defined $hash->{$column}) {
                    die "Illegal object value for $table: $column cannot be NULL because it exists in an alternate key";
                }
            }
        }
    }
    &App::sub_exit() if ($App::trace);
}

sub last_inserted_id {
    my ($self, $table) = @_;
    my $repname = $self->{table}{$table}{repository};
    my $realtable = $self->{table}{$table}{table} || $table;
    my ($id);
    if (defined $repname && $repname ne $self->{name}) {
        my $rep = $self->{context}->repository($repname);
        $id = $rep->last_inserted_id($realtable);
    }
    elsif (defined $realtable && $realtable ne $table) {
        $id = $self->last_inserted_id($realtable);
    }
    else {
        $id = $self->_last_inserted_id($table);
    }
    return($id);
}

sub _last_inserted_id {
    my ($self, $table) = @_;
    return(undef);  # sorry. maybe some subclass will know how to do this.
}

# $nrows = $rep->insert_rows ($table, \@cols, \@rows);
sub insert_rows {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $cols, $rows, $options) = @_;
    my $repname = $self->{table}{$table}{repository};
    my $realtable = $self->{table}{$table}{table} || $table;
    my ($nrows);
    if (defined $repname && $repname ne $self->{name}) {