view release on metacpan or  search on metacpan

lib/Catalyst/Plugin/AutoCRUD/Model/StorageEngine/DBIC/CRUD.pm  view on Meta::CPAN

my $is_numberish = { map {$_ => 1} qw/
    bigint
    bigserial
    dec
    decimal
    double precision
    float
    int
    integer
    mediumint
    money
    numeric
    real
    smallint
    serial
    tinyint
    year
/ };

# stringify a row of fields according to rules described in our POD
sub _stringify {
    my $row = shift;
    return () if !defined $row or !blessed $row;
    return (
        eval { $row->display_name } || (
            overload::Method($row, '""')
        ? $row.''
        : (
            $row->result_source->source_name .': '.
            join (', ', map { $_ .'('. $row->get_column($_) .')' }
                            $row->primary_columns)
        ))
    );
}

# create a JSON dict for this row's PK
sub _create_JSON_ID {
    my $row = shift;
    return undef if !defined $row or !blessed $row;
    return [map {{
        tag => 'input',
        type => 'hidden',
        name => 'cpac_filter.'. $_,
        value => $row->get_column($_),
    }} $row->primary_columns];
}

# create a unique identifier for this row from PKs
sub _create_ID {
    my $row = shift;
    return join "\000\000",
        map { "$_\000${\$row->get_column($_)}" } $row->primary_columns;
}

# take unique identifier and reconstruct hash of row PK vals
sub _extract_ID {
    my ($val, $finder, $prefix, $map) = @_;
    $prefix = $prefix ? "$prefix." : '';
    $finder ||= {};

    foreach my $i (split m/\000\000/, $val) {
        my ($k, $v) = split m/\000/, $i;
        $k = $map->{$k} if $map;
        $finder->{"$prefix$k"} = $v;
    }
    return $finder;
}

# find whether this DMBS supports ILIKE or just LIKE
sub _likeop_for {
    my $model = shift;
    my $sqlt_type = $model->result_source->storage->sqlt_type;
    my %ops = (
        SQLite => '-like',
        MySQL  => '-like',
        Oracle => '-like',
    );
    return $ops{$sqlt_type} || '-ilike';
}

sub list {
    my ($self, $c) = @_;
    my $conf = $c->stash->{cpac}->{tc};
    my $meta = $c->stash->{cpac}->{tm};

    my $response = $c->stash->{json_data} = {};
    my @columns = @{$conf->{cols}};

    my ($page, $limit, $sort, $dir) =
        @{$c->stash}{qw/ cpac_page cpac_limit cpac_sortby cpac_dir /};
    my $filter = {}; my $search_opts = {};

    # sanity check the sort param
    $sort = $c->stash->{cpac}->{g}->{default_sort}
        if not (defined $sort and $sort =~ m/^[\w ]+$/ and exists $meta->f->{$sort});
    $sort = $c->stash->{cpac}->{g}->{default_sort}
        if $meta->f->{$sort}->extra('rel_type') and $meta->f->{$sort}->extra('rel_type') =~ m/_many$/;

    # we want to prefetch all related data for _stringify
    foreach my $rel (@columns) {
        next unless ($meta->f->{$rel}->is_foreign_key or $meta->f->{$rel}->extra('is_reverse'));
        next if $meta->f->{$rel}->extra('rel_type') and $meta->f->{$rel}->extra('rel_type') =~ m/_many$/;
        next if $meta->f->{$rel}->extra('masked_by');
        push @{$search_opts->{prefetch}}, $rel;
    }

    # use of FK or RR partial text filter must disable the DB-side page/sort
    my %delay_page_sort = ();
    foreach my $p (keys %{$c->req->params}) {
        next unless (my $col) = ($p =~ m/^cpac_filter\.([\w ]+)/);
        next unless exists $meta->f->{$col}
            and ($meta->f->{$col}->is_foreign_key or $meta->f->{$col}->extra('is_reverse'));

        $delay_page_sort{$col} += 1
            if $c->req->params->{"cpac_filter.$col"} !~ m/\000/;
    }

    # find filter fields in UI form that can be passed to DB
    foreach my $p (keys %{$c->req->params}) {
        next unless (my $col) = ($p =~ m/^cpac_filter\.([\w ]+)/);
        next unless exists $meta->f->{$col};
        next if exists $delay_page_sort{$col};