File Coverage

blib/lib/DBIx/Class/Helper/ResultSet/AutoRemoveColumns.pm

Criterion	Covered	Total	%
statement	22	22	100.0
branch	6	6	100.0
condition	4	6	66.6
subroutine	6	6	100.0
pod	1	1	100.0
total	39	41	95.1

package DBIx::Class::Helper::ResultSet::AutoRemoveColumns;
$DBIx::Class::Helper::ResultSet::AutoRemoveColumns::VERSION = '2.035000';
# ABSTRACT: Automatically remove columns from a ResultSet

use strict;
use warnings;

use parent 'DBIx::Class::Helper::ResultSet::RemoveColumns', 'DBIx::Class::ResultSet';

__PACKAGE__->mk_group_accessors(inherited => '_fetchable_columns');

my %dont_fetch = (
   text  => 1,
   ntext => 1,
   blob  => 1,
   clob  => 1,
   bytea  => 1,
);

sub _should_column_fetch {
   my ( $self, $column ) = @_;

   my $info = $self->result_source->column_info($column);

   if (!defined $info->{remove_column}) {
      if (defined $info->{data_type} &&
          $dont_fetch{lc $info->{data_type}}
      ) {
         $info->{remove_column} = 1;
      } else {
         $info->{remove_column} = 0;
      }
   }

   return $info->{remove_column};
}

sub fetchable_columns {
   my $self = shift;
   if (!$self->_fetchable_columns) {
     $self->_fetchable_columns([
        grep $self->_should_column_fetch($_),
           $self->result_source->columns
      ]);
   }
   return $self->_fetchable_columns;
}

sub _resolved_attrs {
   local $_[0]->{attrs}{remove_columns} =
      $_[0]->{attrs}{remove_columns} || $_[0]->fetchable_columns;

   return $_[0]->next::method;
}

1;

__END__

=pod

=head1 NAME

DBIx::Class::Helper::ResultSet::AutoRemoveColumns - Automatically remove columns from a ResultSet

=head1 SYNOPSIS

 package MySchema::Result::Bar;

 use strict;
 use warnings;

 use parent 'DBIx::Class::Core';

 __PACKAGE__->table('KittenRobot');
 __PACKAGE__->add_columns(
    id => {
       data_type         => 'integer',
       is_auto_increment => 1,
    },
    kitten => {
       data_type         => 'integer',
    },
    robot => {
       data_type         => 'text',
       is_nullable       => 1,
    },
    your_mom => {
       data_type         => 'blob',
       is_nullable       => 1,
       remove_column     => 0,
    },
 );

 1;

 package MySchema::ResultSet::Bar;

 use strict;
 use warnings;

 use parent 'DBIx::Class::ResultSet';

 __PACKAGE__->load_components('Helper::ResultSet::AutoRemoveColumns');

=head1 DESCRIPTION

This component automatically removes "heavy-weight" columns.  To be specific,
columns of type C<text>, C<ntext>, C<blob>, C<clob>, or C<bytea>.  You may
use the C<remove_column> key in the column info to specify directly whether or
not to remove the column automatically. See
L<DBIx::Class::Helper::ResultSet/NOTE> for a nice way to apply it to your
entire schema.

=head1 METHODS

=head2 _should_column_fetch

 $self->_should_column_fetch('kitten')

returns true if a column should be fetched or not.  This fetches a column if it
is not of type C<text>, C<ntext>, C<blob>, C<clob>, or C<bytea> or the
C<remove_column> is set to true.  If you only wanted to explicitly state which
columns to remove you might override this method like this:

 sub _should_column_fetch {
    my ( $self, $column ) = @_;

    my $info = $self->column_info($column);

    return !defined $info->{remove_column} || $info->{remove_column};
 }

=head2 fetchable_columns

simply returns a list of columns that are fetchable.

=head1 AUTHOR

Arthur Axel "fREW" Schmidt <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut