view release on metacpan or  search on metacpan

lib/DBIx/Class/Candy/ResultSet.pm  view on Meta::CPAN

      $skipnext--;
      next;
    }

    if ( $val eq '-base' ) {
      $base = $args[$idx + 1];
      $skipnext = 1;
    } elsif ( $val eq '-perl5' ) {
      $perl_version = ord $args[$idx + 1];
      $skipnext = 1;
    } elsif ( $val eq '-experimental' ) {
      $experimental = $args[$idx + 1];
      $skipnext = 1;
    } elsif ( $val eq '-components' ) {
      $components = $args[$idx + 1];
      $skipnext = 1;
    } else {
      push @rest, $val;
    }
  }

  return {
    base         => $base,
    perl_version => $perl_version,
    components   => $components,
    rest         => \@rest,
    experimental => $experimental,
  };
}

sub installer {
  my ($self) = @_;
  sub {
    Sub::Exporter::default_installer @_;
  }
}

sub set_base {
   my ($self, $inheritor, $base) = @_;

   # inlined from parent.pm
   for ( my @useless = $self->base($base) ) {
      s{::|'}{/}g;
      require "$_.pm"; # dies if the file is not found
   }

   {
      no strict 'refs';
      # This is more efficient than push for the new MRO
      # at least until the new MRO is fixed
      @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , $self->base($base));
   }
}

sub gen_INIT {
  my ($self, $perl_version, $inheritor, $experimental) = @_;
  sub {
    my $orig = $_[1]->{import_args};
    $_[1]->{import_args} = [];

    strict->import;
    warnings->import;

    if ($perl_version) {
       require feature;
       feature->import(":5.$perl_version")
    }

    if ($experimental) {
       require experimental;
       die 'experimental arg must be an arrayref!'
          unless ref $experimental && ref $experimental eq 'ARRAY';
       # to avoid experimental referring to the method
       experimental::->import(@$experimental)
    }

    mro::set_mro($inheritor, 'c3');

    1;
  }
}

1;

__END__

=pod

=head1 NAME

DBIx::Class::Candy::ResultSet - Sugar for your resultsets

=head1 SYNOPSIS

 package MyApp::Schema::ResultSet::Artist;

 use DBIx::Class::Candy::ResultSet
   -components => ['Helper::ResultSet::Me'];

 use experimental 'signatures';

 sub by_name ($self, $name) { $self->search({ $self->me . 'name' => $name }) }

 1;

=head1 DESCRIPTION

C<DBIx::Class::Candy::ResultSet> is an initial sugar layer in the spirit of
L<DBIx::Class::Candy>.  Unlike the original it does not define a DSL, though I
do have plans for that in the future.  For now all it does is set some imports:

=over

=item *

turns on strict and warnings

=item *

sets your parent class