1package DBIx::Class::Candy::ResultSet; 2$DBIx::Class::Candy::ResultSet::VERSION = '0.005003'; 3use strict; 4use warnings; 5 6use MRO::Compat; 7use Sub::Exporter 'build_exporter'; 8use Carp 'croak'; 9 10# ABSTRACT: Sugar for your resultsets 11 12sub base { return $_[1] || 'DBIx::Class::ResultSet' } 13 14sub perl_version { return $_[1] } 15 16sub experimental { $_[1] } 17 18sub import { 19 my $self = shift; 20 21 my $inheritor = caller(0); 22 my $args = $self->parse_arguments(\@_); 23 my $perl_version = $self->perl_version($args->{perl_version}); 24 my $experimental = $self->experimental($args->{experimental}); 25 my @rest = @{$args->{rest}}; 26 27 $self->set_base($inheritor, $args->{base}); 28 $inheritor->load_components(@{$args->{components}}); 29 30 @_ = ($self, @rest); 31 my $import = build_exporter({ 32 installer => $self->installer, 33 collectors => [ INIT => $self->gen_INIT($perl_version, $inheritor, $experimental) ], 34 }); 35 36 goto $import 37} 38 39sub parse_arguments { 40 my $self = shift; 41 my @args = @{shift @_}; 42 43 my $skipnext; 44 my $base; 45 my @rest; 46 my $perl_version = undef; 47 my $components = []; 48 my $experimental; 49 50 for my $idx ( 0 .. $#args ) { 51 my $val = $args[$idx]; 52 53 next unless defined $val; 54 if ($skipnext) { 55 $skipnext--; 56 next; 57 } 58 59 if ( $val eq '-base' ) { 60 $base = $args[$idx + 1]; 61 $skipnext = 1; 62 } elsif ( $val eq '-perl5' ) { 63 $perl_version = ord $args[$idx + 1]; 64 $skipnext = 1; 65 } elsif ( $val eq '-experimental' ) { 66 $experimental = $args[$idx + 1]; 67 $skipnext = 1; 68 } elsif ( $val eq '-components' ) { 69 $components = $args[$idx + 1]; 70 $skipnext = 1; 71 } else { 72 push @rest, $val; 73 } 74 } 75 76 return { 77 base => $base, 78 perl_version => $perl_version, 79 components => $components, 80 rest => \@rest, 81 experimental => $experimental, 82 }; 83} 84 85sub installer { 86 my ($self) = @_; 87 sub { 88 Sub::Exporter::default_installer @_; 89 } 90} 91 92sub set_base { 93 my ($self, $inheritor, $base) = @_; 94 95 # inlined from parent.pm 96 for ( my @useless = $self->base($base) ) { 97 s{::|'}{/}g; 98 require "$_.pm"; # dies if the file is not found 99 } 100 101 { 102 no strict 'refs'; 103 # This is more efficient than push for the new MRO 104 # at least until the new MRO is fixed 105 @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , $self->base($base)); 106 } 107} 108 109sub gen_INIT { 110 my ($self, $perl_version, $inheritor, $experimental) = @_; 111 sub { 112 my $orig = $_[1]->{import_args}; 113 $_[1]->{import_args} = []; 114 115 strict->import; 116 warnings->import; 117 118 if ($perl_version) { 119 require feature; 120 feature->import(":5.$perl_version") 121 } 122 123 if ($experimental) { 124 require experimental; 125 die 'experimental arg must be an arrayref!' 126 unless ref $experimental && ref $experimental eq 'ARRAY'; 127 # to avoid experimental referring to the method 128 experimental::->import(@$experimental) 129 } 130 131 mro::set_mro($inheritor, 'c3'); 132 133 1; 134 } 135} 136 1371; 138 139__END__ 140 141=pod 142 143=head1 NAME 144 145DBIx::Class::Candy::ResultSet - Sugar for your resultsets 146 147=head1 SYNOPSIS 148 149 package MyApp::Schema::ResultSet::Artist; 150 151 use DBIx::Class::Candy::ResultSet 152 -components => ['Helper::ResultSet::Me']; 153 154 use experimental 'signatures'; 155 156 sub by_name ($self, $name) { $self->search({ $self->me . 'name' => $name }) } 157 158 1; 159 160=head1 DESCRIPTION 161 162C<DBIx::Class::Candy::ResultSet> is an initial sugar layer in the spirit of 163L<DBIx::Class::Candy>. Unlike the original it does not define a DSL, though I 164do have plans for that in the future. For now all it does is set some imports: 165 166=over 167 168=item * 169 170turns on strict and warnings 171 172=item * 173 174sets your parent class 175 176=item * 177 178sets your mro to C<c3> 179 180=back 181 182=head1 IMPORT OPTIONS 183 184See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these schema wide. 185 186=head2 -base 187 188 use DBIx::Class::Candy::ResultSet -base => 'MyApp::Schema::ResultSet'; 189 190The first thing you can do to customize your usage of C<DBIx::Class::Candy::ResultSet> 191is change the parent class. Do that by using the C<-base> import option. 192 193=head2 -components 194 195 use DBIx::Class::Candy::ResultSet -components => ['Helper::ResultSet::Me']; 196 197C<DBIx::Class::Candy::ResultSet> allows you to set which components you are using at 198import time. 199 200=head2 -perl5 201 202 use DBIx::Class::Candy::ResultSet -perl5 => v20; 203 204I love the new features in Perl 5.20, so I felt that it would be 205nice to remove the boiler plate of doing C<< use feature ':5.20' >> and 206add it to my sugar importer. Feel free not to use this. 207 208=head1 SETTING DEFAULT IMPORT OPTIONS 209 210Eventually you will get tired of writing the following in every single one of 211your resultsets: 212 213 use DBIx::Class::Candy::ResultSet 214 -base => 'MyApp::Schema::ResultSet', 215 -perl5 => v20, 216 -experimental => ['signatures']; 217 218You can set all of these for your whole schema if you define your own C<Candy::ResultSet> 219subclass as follows: 220 221 package MyApp::Schema::Candy::ResultSet; 222 223 use base 'DBIx::Class::Candy::ResultSet'; 224 225 sub base { $_[1] || 'MyApp::Schema::ResultSEt' } 226 sub perl_version { 20 } 227 sub experimental { ['signatures'] } 228 229Note the C<< $_[1] || >> in C<base>. All of these methods are passed the 230values passed in from the arguments to the subclass, so you can either throw 231them away, honor them, die on usage, or whatever. To be clear, if you define 232your subclass, and someone uses it as follows: 233 234 use MyApp::Schema::Candy::ResultSet 235 -base => 'MyApp::Schema::ResultSet', 236 -perl5 => v18, 237 -experimental => ['postderef']; 238 239Your C<base> method will get C<MyApp::Schema::ResultSet>, your C<experimental> 240will get C<['postderef']>, and your C<perl_version> will get C<18>. 241 242=head1 AUTHOR 243 244Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com> 245 246=head1 COPYRIGHT AND LICENSE 247 248This software is copyright (c) 2017 by Arthur Axel "fREW" Schmidt. 249 250This is free software; you can redistribute it and/or modify it under 251the same terms as the Perl 5 programming language system itself. 252 253=cut 254