DBIx-DBO

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

        'Storable' => 2.38,
    },
    meta_merge => {
        resources => {
            bugtracker => 'https://github.com/vlyon/DBIx-DBO/issues',
            repository => 'git://github.com/vlyon/DBIx-DBO.git',
        },
    },
);

unless (exists &Scalar::Util::weaken) {
    # The pure-perl Scalar::Util doesn't contain weaken(), Task::Weaken will try to fix it or give an error
    $build{requires}{'Task::Weaken'} = 0;
}

Module::Build->subclass(code => q(
    sub ACTION_testcover {
        $ENV{DEVEL_COVER_OPTIONS} = '-ignore,^Test/,-coverage,all,pod-also_private-STORABLE_'
            unless exists $ENV{DEVEL_COVER_OPTIONS};
        print "DEVEL_COVER_OPTIONS = $ENV{DEVEL_COVER_OPTIONS}\n";
        shift->SUPER::ACTION_testcover;
    }

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

package DBIx::DBO::Query;

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

use Carp 'croak';
use Devel::Peek 'SvREFCNT';
use Hash::Util 'hv_store';
use Scalar::Util 'weaken';

use overload '**' => \&column, fallback => 1;

sub table_class { $_[0]{DBO}->table_class }
sub row_class { $_[0]{DBO}->row_class }

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

=head1 NAME

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

    pop @_recursion_check;
}

sub _add_up_query {
    my($me, $upquery) = @_;

    $me->_recursion_check($upquery);

    my $uq = $me->{up_queries} //= [];
    push @$uq, $upquery;
    weaken $uq->[-1];
}

sub sql {
    my $me = shift;
    return $me->{DBO}{dbd_class}->_build_sql_select($me);
}

sub _inactivate {
    my $me = shift;
    $me->_empty_row;

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

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

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};
}