view release on metacpan or  search on metacpan

lib/DBIx/Class/Helper/TableSample.pm  view on Meta::CPAN

package DBIx::Class::Helper::TableSample;

# ABSTRACT: Add support for tablesample clauses

use v5.14;
use warnings;

use parent 'DBIx::Class';

use Ref::Util qw/ is_plain_arrayref is_plain_hashref is_plain_scalarref /;

# RECOMMEND PREREQ: Ref::Util::XS

use namespace::clean;

our $VERSION = 'v0.7.0';


sub _resolved_attrs {
    my $rs    = $_[0];

    $rs->next::method;

    my $attrs = $rs->{_attrs};

    if ( my $conf = delete $attrs->{tablesample} ) {

        my $from = $attrs->{from};

        $conf = { fraction => $conf } unless is_plain_hashref($conf);

        $rs->throw_exception('tablesample must be a hashref')
            unless is_plain_hashref($conf);

        my $sqla = $rs->result_source->storage->sql_maker;

        my $part_sql = " tablesample";

        if (my $type = ($conf->{method} // $conf->{type})) {
            $part_sql .= " $type";
        }

        my $arg = $conf->{fraction};
        $arg = $$arg if is_plain_scalarref($arg);
        $part_sql .= "($arg)";

        if ( defined $conf->{repeatable} ) {
            my $seed = $conf->{repeatable};
            $seed = $$seed if is_plain_scalarref($seed);
            $part_sql .= sprintf( ' repeatable (%s)', $seed );
        }

        if (is_plain_arrayref($from)) {
            my $sql = $sqla->_from_chunk_to_sql($from->[0]) . $sqla->_sqlcase($part_sql);
            $from->[0] = \$sql;
        }
        else {
            my $sql = $sqla->_from_chunk_to_sql($from) . $sqla->_sqlcase($part_sql);
            $attrs->{from} = \$sql;
        }

    }

    return $attrs;
}


sub tablesample {
    my ( $rs, $frac, $options ) = @_;
    $options //= {};
    $options = { method => $options } unless is_plain_hashref($options);
    return $rs->search_rs(