The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Catalyst::TraitFor::Component::ConfigPerSite;
use strict;
use warnings;
use Carp qw(carp cluck);

=head1 NAME

Catalyst::TraitFor::Component::ConfigPerSite - Extend Catalyst Components to share application accross sites

=head1 DESCRIPTIONS

This Role or Trait allows you to share an application between sites, clients, etc
with different configuration for templates and databases (and possibly other parts).

Compose this role into your trait to extend a catalyst component such as a model or view

=head1 SYNOPSIS

    in testblogapp.conf:

    name         TestBlogApp
    site_name    TestBlog
    default_view TT

    <Model::DB>
        schema_class TestBlogApp::Schema
        <connect_info>
            dsn dbi:SQLite:dbname=t/test.db
            user username
            password password
        </connect_info>
    </Model::DB>

    <View::TT>
        TEMPLATE_EXTENSION .tt
        WRAPPER            site-wrapper.tt
        INCLUDE_PATH       t/templates
    </View::TT>

    <TraitFor::Component::ConfigPerSite>
        <foo.bar>
            <Model::DB>
                schema_class TestBlogApp::Schema
                <connect_info>
                    dsn dbi:SQLite:dbname=t/test2.db
                    user username
                    password password
                </connect_info>
                instance_cache_key foo_bar_model_db
            </Model::DB>

            <View::TT>
                TEMPLATE_EXTENSION .tt
                WRAPPER            site-wrapper.tt
                INCLUDE_PATH       t/more_templates
                instance_cache_key foo_bar_view_tt
            </View::TT>

        </foo.bar>
    </TraitFor::Component::ConfigPerSite>

=head1 VERSION

0.10

=cut

our $VERSION = '0.10';

use Moose::Role;
use MRO::Compat;
use Data::Dumper;

my $site_config_cache = { };

my $shared_config;

has '_site_config' => ( is  => 'ro' );

=head1 METHODS

=head2 get_site_config

return (possibly cached) site-specific configuration based on host and path for this request

    my $site_config = $self->get_site_config($c);

=cut

sub get_site_config {
    my ($self, $c) = @_;

    $shared_config ||= $c->config->{'TraitFor::Component::ConfigPerSite'};

    # get configuration from host and/or path
    my $req = $c->request;
    my $host = $req->uri->host;
    my $path = $req->uri->path;

    my $cache_key = $host.$path;
    my $site_config = $site_config_cache->{$cache_key};

    if ( not defined $site_config ) {
	if (my $host_config = $shared_config->{$host} || $shared_config->{ALL}) {
	    if (scalar keys %$host_config > 1) {
		my @path_parts = split(/\/+/, $path);
		while (my $last_path_part = pop(@path_parts)) {
		    my $match_path = join ('/',@path_parts,$last_path_part);
		    if ( $site_config = $host_config->{"/$match_path"} || $host_config->{"$match_path"}) {
			last;
		    }
		}
		$site_config ||= $host_config->{ALL} || $host_config;
	    } else {
		($site_config) = values %$host_config;
	    }
	    $site_config->{site_name} = "host:$host";

	    # inherit top level config where not over-ridden
	    my $top_level_config = $c->config;
	    foreach my $key (keys %$top_level_config) {
		unless (defined $site_config->{$key}) {
		    $site_config->{$key} = $top_level_config->{$key};
		}
	    }

	} else {
	    # if none found fall back to top level config for DBIC, and warn
	    $site_config = { site_name => 'top_level_fallback', %{$c->config} };
	    carp "falling back to top level config" if ($c->debug);
	}



	$site_config_cache->{$cache_key} = $site_config;
    } else {
	carp "no matching site config!\n";
    }


    return $site_config;
}

=head2 get_component_config

return appropriate configuration for this component for this site

    my $config = $self->get_component_config;

=cut

sub get_component_config {
    my ($self, $c) = @_;

    my $component_name = $self->catalyst_component_name;
    my $site_config = $self->get_site_config($c);
    my $appname = $site_config->{name}.'::';
    $component_name =~ s/$appname//;
    my $component_config = $site_config->{$component_name};
    $component_config->{site_name} = $site_config->{site_name};
    return $component_config;
}

=head2 get_from_instance_cache

    if (my $instance = $self->get_from_instance_cache($config)) {
        return $instance;
    }

=cut

our $instances = {};

sub get_from_instance_cache {
    my ($self,$config) = @_;
    my $instance_cache_key = $config->{instance_cache_key};
    my $instance;
    if ($instance_cache_key && $instances->{$instance_cache_key}) {
	$instance = $instances->{$instance_cache_key};
    }
    return $instance;
}

=head2 put_in_instance_cache

    $self->put_in_instance_cache($config, $instance);

=cut

sub put_in_instance_cache {
    my ($self,$config, $instance) = @_;
    my $instance_cache_key = $config->{instance_cache_key};
    return undef unless ($instance_cache_key);
    $instances->{$instance_cache_key} = $instance;
    return;
}


=head1 SEE ALSO

Catalyst::Component::InstancePerContext

Catalyst::TraitFor::View::TT::ConfigPerSite

Moose::Role

=head1 AUTHOR

Aaron Trevena, E<lt>aaron@aarontrevena.co.ukE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010,2011 by Aaron Trevena

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut

1;