view release on metacpan or  search on metacpan

lib/DBIx/DBO/Row.pm  view on Meta::CPAN

package DBIx::DBO::Row;

use 5.014;
use warnings;
use DBIx::DBO;

use Carp 'croak';
use Scalar::Util qw(blessed weaken);
use Storable ();

use overload '@{}' => sub {${$_[0]}->{array} || []}, '%{}' => sub {${$_[0]}->{hash}}, fallback => 1;

sub query_class { ${$_[0]}->{DBO}->query_class }

*_isa = \&DBIx::DBO::DBD::_isa;

=head1 NAME

DBIx::DBO::Row - An OO interface to SQL queries and results.  Encapsulates a fetched row of data in an object.

=head1 SYNOPSIS

  # Create a Row object for the `users` table
  my $row = $dbo->row('users');
  
  # Load my record
  $row->load(login => 'vlyon') or die "Where am I?";
  
  # Double my salary :)
  $row->update(salary => {FUNC => '? * 2', COL => 'salary'});
  
  # Print my email address
  print $row->{email};
  
  # Delete my boss
  $row->load(id => $row->{boss_id})->delete or die "Can't kill the boss";

=head1 METHODS

=head3 C<new>

  DBIx::DBO::Row->new($dbo, $table);
  DBIx::DBO::Row->new($dbo, $query_object);

Create and return a new C<Row> object.
The object returned represents rows in the given table/query.
Can take the same arguments as L<DBIx::DBO::Query/new> or a L<Query|DBIx::DBO::Query> object can be used.

=cut

sub new {
    my $proto = shift;
    eval { $_[0]->isa('DBIx::DBO') } or croak 'Invalid DBO Object for new Row';
    my $class = ref($proto) || $proto;
    $class->_init(@_);
}

sub _init {
    my($class, $dbo, @args) = @_;

    my $me = bless \{ DBO => $dbo, array => undef, hash => {} }, $class;
    my $parent = (@args == 1 and _isa($args[0], 'DBIx::DBO::Query'))
    ? $args[0]
    : $me->query_class->new($dbo, @args);

    if ($parent->isa('DBIx::DBO::Query')) {
        croak 'This query is from a different DBO connection' if $parent->{DBO} != $dbo;
        # We must weaken this to avoid a circular reference
        $$me->{Parent} = $parent;
        weaken $$me->{Parent};
        # Add a weak ref onto the list of attached_rows to release freed rows
        push @{ $$me->{Parent}{attached_rows} }, $me;
        weaken $$me->{Parent}{attached_rows}[-1];
    } else {
        croak 'Invalid parent for new Row';
    }
    return wantarray ? ($me, $me->tables) : $me;
}

sub _build_data {
    ${$_[0]}->{build_data} // ${$_[0]}->{Parent}{build_data};
}

=head3 C<tables>

Return a list of L<Table|DBIx::DBO::Table> objects for this row.

=cut

sub tables {
    my $me = $_[0];
    return @{ ${exists $$me->{Parent} ? $$me->{Parent} : $$me}{Tables} };
}

sub _table_idx {
    my($me, $tbl) = @_;
    my $tables = ${exists $$me->{Parent} ? $$me->{Parent} : $$me}{Tables};
    for my $i (0 .. $#$tables) {
        return $i if $tbl == $tables->[$i];
    }
    return undef;
}

sub _table_alias {
    my($me, $tbl) = @_;
    return undef if $tbl == $me;
    my $i = $me->_table_idx($tbl);
    croak 'The table is not in this query' unless defined $i;
    return $me->tables > 1 ? 't'.($i + 1) : ();
}

=head3 C<columns>

Return a list of column names.

=cut

sub columns {
    my($me) = @_;

    return $$me->{Parent}->columns if exists $$me->{Parent};

    $$me->{Columns} //= [
        @{$me->_build_data->{select}}
        ? map {
                _isa($_, 'DBIx::DBO::Table', 'DBIx::DBO::Query') ? ($_->columns) : $me->_build_col_val_name(@$_)
            } @{$me->_build_data->{select}}
        : map { $_->columns } $me->tables
    ];

    @{$$me->{Columns}};
}