view release on metacpan or  search on metacpan

lib/Metabase/Web/Model/Metabase.pm  view on Meta::CPAN

Metabase::Web::Model::Metabase - the Metabase::Web's model for the Metabase

=head1 DESCRIPTION

This model sets up a gateway, complete with librarians and archivers, and
provides easy access to them.  Most of the logic that Metabase::Web will rely
in for retrieving or adding facts is either in
L<Metabase::Web::Controller::Root|Metabase::Web::Controller::Root> or the
Gateway and Librarian classes.

=head1 CONFIGURATION

Configuration can be used to configure the librarians (public and secret), the
gateway, and the archives and indices.  Valid configuration may look like:

  gateway:
    CLASS: the gateway class (defaults to Metabase::Gateway)
    librarian:
      CLASS: the librarian class (defaults to Metabase::Librarian)
      archive:
        CLASS: the archive class (defaults to Metabase::Archive::Filesystem)
      index:
        CLASS: the index class (defaults to Metabase::Index::FlatFile)
    secret_librarian: (same structure as librarian)
  fact_classes: [ arrayref of allowed Fact classes ]

(This section will be expanded in the future.)

=cut

my $default_config = {
  gateway   => {
    CLASS => 'Metabase::Gateway',
    librarian => {
      CLASS => 'Metabase::Librarian',
      archive => { CLASS => 'Metabase::Archive::Filesystem' },
      index   => { CLASS => 'Metabase::Index::FlatFile'     },
    },
    secret_librarian => {
      CLASS   => 'Metabase::Librarian',
      archive => { CLASS => 'Metabase::Archive::Filesystem' },
      index   => { CLASS => 'Metabase::Index::FlatFile'     },
    },
  },
};

sub _initialize {
  my ($self, $entry, $extra) = @_;
  my $merged = Catalyst::Utils::merge_hashes($entry, $extra);

  my $class = delete $merged->{CLASS};
  eval "require $class; 1" or die "couldn't load Model::Metabase class: $@";
  my $obj = $class->new($merged);
}

sub COMPONENT {
  my ($class, $c, $user_config) = @_;

  my $config = Catalyst::Utils::merge_hashes($default_config, $user_config);

  my $self = bless {} => $class;
  
  my $fact_classes = $config->{fact_classes};
  Carp::croak "no fact_classes supplied to $class configuration"
    unless $fact_classes and @$fact_classes;

  # XXX why are we loading classes here?  why not leave to gateway instead?
  # -- dagolden, 2009-03-31
  for my $fact_class (@$fact_classes) {
    Carp::croak "invalid fact class: $fact_class" unless _CLASS($fact_class);
    eval "require $fact_class; 1" or die "couldn't load fact class: $@";
  }

  my %librarian;

  for my $which (qw(librarian secret_librarian)) {
    my ($archive, $index);
    my $config = $config->{gateway}{$which};

    if ($config->{database}) {
      # This branch is here mostly to remind me that something like this should
      # be possible. -- rjbs, 2008-04-14
      $archive = $index = $self->_initialize($config->{database});
    } else {
      $archive = $self->_initialize($config->{archive});
      $index   = $self->_initialize($config->{index});
    }
    
    delete @$config{qw(database archive index)};

    $librarian{ $which } = $self->_initialize(
      $config,
      {
        archive => $archive,
        index   => $index,
      },
    );
  }

  my $gateway = $self->_initialize(
    $config->{gateway},
    {
      fact_classes => $fact_classes,
      %librarian
    },
  );

  # XXX: This is sort of a massive hack, but it makes testing easy by giving us
  # access to the gateway the test server will use. -- rjbs, 2009-03-30
  if (my $code = our $COMPONENT_CALLBACK) {
    $code->($gateway);
  }

  $self->{gateway} = $gateway;
  return $self;
}

=head1 METHODS

=head2 gateway