lib/SGN/Role/Site/SiteFeatures.pm

   1 =head1 NAME
   2
   3 SGN::Role::Site::SiteFeatures - role for a context class that lets it find, load, and configure SGN::Feature objects
   4
   5 =cut
   6
   7 package SGN::Role::Site::SiteFeatures;
   8 use 5.10.0;
   9
  10 use Moose::Role;
  11
  12 use Module::Pluggable::Object;
  13 use namespace::autoclean;
  14 use Try::Tiny;
  15
  16 requires 'config';
  17
  18 after 'setup_finalize' => sub {
  19         my $class = shift;
  20         $class->_features; #< build features
  21         $class->setup_features;
  22 };
  23
  24 # lazy accessor, returns arrayref of instantiated and configured
  25 # SGN::Feature objects
  26 sub _features {
  27     my $class = shift;
  28     $class = ref $class if ref $class;
  29     state %feature_objects;
  30     $feature_objects{$class} ||= do {
  31         $class->_build__features;
  32     };
  33 }
  34
  35 sub features {
  36     values %{ shift->_features }
  37 }
  38
  39 sub feature {
  40     shift->_features->{+shift};
  41 }
  42
  43 sub site_name {
  44     shift->config->{name};
  45 }
  46
  47 sub _build__features {
  48     my $self = shift;
  49     my @feature_classes =
  50         Module::Pluggable::Object
  51               ->new( 'search_path' => ['SGN::Feature'],
  52                      'require' => 1,
  53                     )
  54                   ->plugins;
  55
  56     my %feature_objects;
  57     foreach my $class (@feature_classes) {
  58         my $cfg = $self->config->{feature}{$class} || {};
  59         if (ref($cfg) eq "HASH" && exists($cfg->{enabled}) && defined($cfg->{enabled}) ) {
  60             try {
  61                 my $f = $class->new( %$cfg,
  62                                      'context' => $self,
  63                                     );
  64                 $feature_objects{$f->feature_name} = $f;
  65             } catch {
  66                 warn "WARNING: failed to configure $class : $_";
  67             }
  68         }
  69     }
  70
  71     return \%feature_objects;
  72 }
  73
  74 sub setup_features {
  75     my $class = shift;
  76     $_->setup( $class ) for $class->enabled_features;
  77 }
  78
  79 sub enabled_features {
  80     grep $_->enabled,
  81       shift->features
  82 }
  83 sub enabled_feature {
  84     my $f = shift->feature(lc shift)
  85         or return;
  86     return unless $f->enabled;
  87     return $f;
  88 }
  89
  90 sub feature_xrefs {
  91     my ( $c, $query, $args ) = @_;
  92     $args ||= {};
  93     my @f = $c->enabled_features;
  94     if( my $ex = $args->{exclude} ) {
  95         $ex = [ $ex ] unless ref $ex;
  96         my %ex = map { $_ => 1 } @$ex;
  97         @f = grep !$ex{$_->feature_name}, @f;
  98     }
  99     return map $_->xrefs( $query, $args ),  @f;
 100 }
 101
 102 1;